SNMP-Extension-PassPersist-0.07000755000765000120 012072411115 16642 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/Build.PL000444000765000120 274412072411115 20302 0ustar00maddingueadmin000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'SNMP::Extension::PassPersist', license => 'perl', dist_author => 'Sebastien Aperghis-Tramoni ', dist_version_from => 'lib/SNMP/Extension/PassPersist.pm', requires => { 'perl' => '5.006', 'Carp' => 0, 'Class::Accessor' => '0.30', 'File::Basename' => 0, 'Getopt::Long' => '2.04', 'IO::Handle' => '1.15', 'IO::Pipe' => '1.12', 'IO::Select' => '1.10', 'List::MoreUtils' => '0.21', 'parent' => '0.221', 'Sys::Syslog' => 0, }, recommends => { 'Sort::Key::OID' => '0.04', }, build_requires => { 'File::Temp' => '0.14', 'IO::File' => '1.05', 'IO::String' => '1.00', 'Test::More' => '0.45', }, meta_merge => { resources => { repository => "https://github.com/maddingue/SNMP-Extension-PassPersist", #{ # type => "git", # url => "git://github.com/maddingue/SNMP-Extension-PassPersist.git", # web => "https://github.com/maddingue/SNMP-Extension-PassPersist", #} }, }, add_to_cleanup => [ 'SNMP-Extension-PassPersist-*' ], ); $builder->create_build_script(); SNMP-Extension-PassPersist-0.07/Changes000444000765000120 355612072411115 20303 0ustar00maddingueadmin000000000000Revision history for SNMP-Extension-PassPersist 0.07 2013.01.07 - Sebastien Aperghis-Tramoni (SAPER) [FEATURE] CPAN-RT#82362: Add support for counter64 (Pete Bristow). [TESTS] Skip some tests under Win32. [CODE] Replaced $/ with explicit "\n" to try fixing tests under Win32. [DIST] No longer include README.pod in the CPAN version. 0.06 2011.08.12 - Sebastien Aperghis-Tramoni (SAPER) [TESTS] Added a mock version of Sys::Syslog to avoid useless dies when running with old versions of the module in white boxes. [TESTS] t/90-pod.t also makes use of Pod::Checker. 0.05 2010.12.15 - Sebastien Aperghis-Tramoni (SAPER) [DIST] Forgot to update MANIFEST. 0.04 2010.12.15 - Sebastien Aperghis-Tramoni (SAPER) [BUGFIX] CPAN-RT#46256: Fixed add_oid_tree(), thanks to Simon Brown. [BUGFIX] CPAN-RT#43579: Fixed fetch_next_entry(), thanks to Aymeric Blazy. [FEATURE] Added forked backend support. [DOC] Improved documentation. [DIST] Seperated build/tests prereqs from run prereqs, and bumped minimum version of File::Temp to 0.14, thanks to Yves Blusseau. [DIST] Added pseudo-walk utility. 0.03 2008.12.18 - Sebastien Aperghis-Tramoni (SAPER) [CODE] CPAN-RT#41749: Applied a patch from Kris Beevers to avoid sorting OIDs when it's unnecessary, then optimising it a bit. [CODE] Fixed a bug regarding how idle cycles are counted, found by Pascal Beringuie. 0.02 2008.11.12 - Sebastien Aperghis-Tramoni (SAPER) [CODE] Made the code compatible with Perl 5.6 [CODE] Implemented add_oid_tree(). [TESTS] Implemented t/11-new.t, t/12-run.t [EG] Added two examples based on the synopsis in eg/. 0.01 2008.11.11 - Sebastien Aperghis-Tramoni (SAPER) First version, released on an unsuspecting world. SNMP-Extension-PassPersist-0.07/Makefile.PL000444000765000120 275212072411115 20757 0ustar00maddingueadmin000000000000use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'SNMP::Extension::PassPersist', AUTHOR => 'Sebastien Aperghis-Tramoni ', VERSION_FROM => 'lib/SNMP/Extension/PassPersist.pm', ABSTRACT_FROM => 'lib/SNMP/Extension/PassPersist.pm', PREREQ_PM => { # prereqs 'Carp' => 0, 'Class::Accessor' => '0.30', 'File::Basename' => 0, 'Getopt::Long' => '2.04', 'IO::Handle' => '1.15', 'IO::Pipe' => '1.12', 'IO::Select' => '1.10', 'List::MoreUtils' => '0.21', 'parent' => '0.221', 'Sys::Syslog' => 0, # build/test prereqs 'File::Temp' => '0.14', 'IO::File' => '1.05', 'IO::String' => '1.00', 'Test::More' => '0.45', }, META_MERGE => { resources => { repository => "https://github.com/maddingue/SNMP-Extension-PassPersist", #{ # type => "git", # url => "git://github.com/maddingue/SNMP-Extension-PassPersist.git", # web => "https://github.com/maddingue/SNMP-Extension-PassPersist", #} }, }, PL_FILES => {}, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'SNMP-Extension-PassPersist-*' }, ); SNMP-Extension-PassPersist-0.07/MANIFEST000444000765000120 57312072411115 20115 0ustar00maddingueadmin000000000000MANIFEST META.yml Build.PL Makefile.PL README Changes lib/SNMP/Extension/PassPersist.pm eg/pseudo-walk eg/synopsis-pass.pl eg/synopsis-passpersist.pl t/00-load.t t/01-api.t t/10-synopsis-pass.t t/10-synopsis-passpersist.t t/11-new.t t/12-run.t t/50-walk.t t/90-pod.t t/91-pod-coverage.t t/lib/Sys/Syslog.pm t/lib/Utils.pm t/bugs/cpan-rt-43579.pl t/bugs/cpan-rt-46256.t META.json SNMP-Extension-PassPersist-0.07/META.json000444000765000120 325712072411115 20427 0ustar00maddingueadmin000000000000{ "abstract" : "Generic pass/pass_persist extension framework", "author" : [ "Sebastien Aperghis-Tramoni " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "SNMP-Extension-PassPersist", "prereqs" : { "build" : { "requires" : { "File::Temp" : "0.14", "IO::File" : "1.05", "IO::String" : "1.00", "Test::More" : "0.45" } }, "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "recommends" : { "Sort::Key::OID" : "0.04" }, "requires" : { "Carp" : "0", "Class::Accessor" : "0.30", "File::Basename" : "0", "Getopt::Long" : "2.04", "IO::Handle" : "1.15", "IO::Pipe" : "1.12", "IO::Select" : "1.10", "List::MoreUtils" : "0.21", "Sys::Syslog" : "0", "parent" : "0.221", "perl" : "5.006" } } }, "provides" : { "SNMP::Extension::PassPersist" : { "file" : "lib/SNMP/Extension/PassPersist.pm", "version" : "0.07" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/maddingue/SNMP-Extension-PassPersist" } }, "version" : "0.07" } SNMP-Extension-PassPersist-0.07/META.yml000444000765000120 173112072411115 20252 0ustar00maddingueadmin000000000000--- abstract: 'Generic pass/pass_persist extension framework' author: - 'Sebastien Aperghis-Tramoni ' build_requires: File::Temp: 0.14 IO::File: 1.05 IO::String: 1.00 Test::More: 0.45 configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: SNMP-Extension-PassPersist provides: SNMP::Extension::PassPersist: file: lib/SNMP/Extension/PassPersist.pm version: 0.07 recommends: Sort::Key::OID: 0.04 requires: Carp: 0 Class::Accessor: 0.30 File::Basename: 0 Getopt::Long: 2.04 IO::Handle: 1.15 IO::Pipe: 1.12 IO::Select: 1.10 List::MoreUtils: 0.21 Sys::Syslog: 0 parent: 0.221 perl: 5.006 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/maddingue/SNMP-Extension-PassPersist version: 0.07 SNMP-Extension-PassPersist-0.07/README000444000765000120 267512072411115 17671 0ustar00maddingueadmin000000000000NAME SNMP::Extension::PassPersist - Generic pass/pass_persist extension framework for Net-SNMP DESCRIPTION This module is a framework for writing Net-SNMP extensions using the pass or pass_persist mechanisms. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install Alternatively, to install with Module::Build, you can use the following commands: perl Build.PL ./Build ./Build test ./Build install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc SNMP::Extension::PassPersist You can also look for information at: Search CPAN http://search.cpan.org/dist/SNMP-Extension-PassPersist Meta CPAN https://metacpan.org/release/SNMP-Extension-PassPersist RT, CPAN's request tracker http://rt.cpan.org/Public/Dist/Display.html?Name=SNMP-Extension-PassPersist AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/SNMP-Extension-PassPersist CPAN Ratings http://cpanratings.perl.org/d/SNMP-Extension-PassPersist COPYRIGHT AND LICENCE Copyright (C) 2008-2011 Sebastien Aperghis-Tramoni This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. SNMP-Extension-PassPersist-0.07/eg000755000765000120 012072411115 17235 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/eg/pseudo-walk000555000765000120 1120012072411115 21565 0ustar00maddingueadmin000000000000#!/usr/bin/perl use strict; use Getopt::Long; use IPC::Run qw< start >; use Time::HiRes qw< sleep >; # # main # ---- MAIN: { run() unless caller(); } # # run() # --- sub run { # default options my %options = ( count => 5, ); # process comand line options Getopt::Long::Configure(qw< no_auto_abbrev no_ignore_case >); GetOptions(\%options, qw{ help|h! version|V! loop|l! count|c=i debug|d! format|as|F=s }) or pod2usage(1); # handle --help and --version $options{help} and pod2usage(2); $options{version} and version(); # debug mode forces normal output $options{format} = "human" if $options{debug}; # check the output format to use if (lc $options{format} eq "json") { if (eval "use JSON; 1") { # use JSON v2 API even with JSON v1 if (JSON->VERSION < 2.00) { no warnings; *to_json = *JSON::encode = \&JSON::objToJson; *from_json = *JSON::decode = \&JSON::jsonToObj; } } else { $options{format} = "human"; } } # read the rest of the arguments my ($first_oid, $extsnmp_bin, @extsnmp_args) = @ARGV; # prepare the command my @cmd = ( $extsnmp_bin, @extsnmp_args ); my ($in, $out, $err) = ("", "", ""); # execute the program my $process = start(\@cmd, \$in, \$out, \$err) or die "fatal: Can't execute '$extsnmp_bin'. Exit status: $?\n"; # wait for the program to initialise sleep .5; my $oid = $first_oid; my $count = $options{count}; my $i = 1; my @data; while ($process->pumpable) { $oid = $oid eq "NONE" ? $first_oid : $oid; $in = "getnext\n$oid\n"; print "--> getnext\n--> $oid\n" if $options{debug}; $process->pump until index($out, $/) > 0; ($oid, my $type, my $value) = split /$\//, $out; $out =~ s/^/<-- /gm, print $out if $options{debug}; $out = ""; if ($oid eq "NONE") { if ($options{loop} and $count > 0) { $count--; if ($options{format} eq "json") { print to_json(\@data), $/; @data = (); } else { print "-" x 10, $/; } next } else { last } } if ($options{format} eq "csv") { print "$oid;$type;$value\n"; } elsif ($options{format} eq "json") { push @data, { oid => $oid, type => $type, value => $value }; } else { print "$oid ($type) = $value\n"; } } print to_json(\@data), $/ if $options{format} eq "json"; $process->finish; } # # pod2usage() # --------- sub pod2usage { my ($level) = @_; if (eval { require Pod::Usage }) { Pod::Usage::pod2usage({ -exitval => 0, -verbose => $level, -noperldoc => 1, }); } else { require Pod::Text; Pod::Text::pod2text(__FILE__, \*STDOUT); exit; } } # # version() # ------- sub version { print "$::PROGRAM v$::VERSION\n"; exit; } 32272 __END__ =head1 NAME pseudo-walk - Manually walk the OID tree provided by a Net-SNMP extension =head1 SYNOPSIS pseudo-walk [--debug] [--loop] [--count N] [--format type] first-oid path/to/snmpext [snmpext args ..] pseudo-walk --help pseudo-walk --version =head1 OPTIONS B =over =item B<-l>, B<--loop> Run in loop mode. =item B<-c>, B<--count> I Specify the number of times to loop over. Defaults to 5. =back B =over =item B<-d>, B<--debug> Enable debug mode, printing the communication with the SNMP extension. =item B<-F>, B<--format> I Specify how to print the data from the SNMP extension. Available types are C, C and C. Defaults to C. =back B =over =item B<-h>, B<--help> Print this help screen and exit. =item B<-V>, B<---version> Print the program name and version and exit. =back =head1 DESCRIPTION This program is a tool to help developers of Net-SNMP C extensions by manually walking the OID tree it provides, as Net-SNMP would do if queried by snmpwalk. =head1 AUTHOR SEbastien Aperghis-Tramoni, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2008-2010 SEbastien Aperghis-Tramoni, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut SNMP-Extension-PassPersist-0.07/eg/synopsis-pass.pl000555000765000120 45212072411115 22546 0ustar00maddingueadmin000000000000#!perl use strict; use SNMP::Extension::PassPersist; # create the object my $extsnmp = SNMP::Extension::PassPersist->new; # add a few OID entries $extsnmp->add_oid_entry(".1.2.42.1", "integer", 42); $extsnmp->add_oid_entry(".1.2.42.2", "string" , "the answer"); # run the program $extsnmp->run; SNMP-Extension-PassPersist-0.07/eg/synopsis-passpersist.pl000555000765000120 60312072411115 24156 0ustar00maddingueadmin000000000000#!perl use strict; use SNMP::Extension::PassPersist; # create the object my $extsnmp = SNMP::Extension::PassPersist->new( backend_collect => \&update_tree, ); # run the program $extsnmp->run; sub update_tree { my ($self) = @_; # add a few OID entries $self->add_oid_entry(".1.2.42.1", "integer", 42); $self->add_oid_entry(".1.2.42.2", "string" , "the answer"); } SNMP-Extension-PassPersist-0.07/lib000755000765000120 012072411115 17410 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/lib/SNMP000755000765000120 012072411115 20165 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/lib/SNMP/Extension000755000765000120 012072411115 22141 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/lib/SNMP/Extension/PassPersist.pm000444000765000120 5343512072411115 25146 0ustar00maddingueadmin000000000000package SNMP::Extension::PassPersist; use strict; use warnings; use parent qw< Class::Accessor >; use Carp; use Getopt::Long; use File::Basename; use IO::Handle; use IO::Pipe; use IO::Select; use List::MoreUtils qw< any >; use Storable qw< nfreeze thaw >; use Sys::Syslog; { no strict "vars"; $VERSION = '0.07'; } use constant HAVE_SORT_KEY_OID => eval "use Sort::Key::OID 0.04 qw; 1" ? 1 : 0; # early initialisations -------------------------------------------------------- my @attributes = qw< backend_collect backend_fork backend_init backend_pipe heap idle_count input oid_tree sorted_entries output refresh dispatch >; __PACKAGE__->mk_accessors(@attributes); # constants -------------------------------------------------------------------- use constant SNMP_NONE => "NONE"; use constant SNMP_PING => "PING"; use constant SNMP_PONG => "PONG"; use constant SNMP_GET => "get"; use constant SNMP_GETNEXT => "getnext"; use constant SNMP_SET => "set"; use constant SNMP_NOT_WRITABLE => "not-writable"; use constant SNMP_WRONG_TYPE => "wrong-type"; use constant SNMP_WRONG_LENGTH => "wrong-length"; use constant SNMP_WRONG_VALUE => "wrong-value"; use constant SNMP_INCONSISTENT_VALUE => "inconsistent-value"; # global variables ------------------------------------------------------------- my %snmp_ext_type = ( counter => "counter", counter64 => "counter64", gauge => "gauge", integer => "integer", ipaddr => "ipaddress", ipaddress => "ipaddress", netaddr => "ipaddress", objectid => "objectid", octetstr => "string", # opaque => "opaque", string => "string", timeticks => "timeticks", ); # # new() # --- sub new { my ($class, @args) = @_; my %attrs; my $ref = ref $args[0]; # see how arguments were passed if ($ref and $ref eq "HASH") { %attrs = %{$args[0]}; } else { croak "error: Don't know how to handle \L$ref reference" if $ref; croak "error: Odd number of arguments" if @args % 2 == 1; %attrs = @args; } # filter out unknown attributes my %known_attr; @known_attr{@attributes} = (1) x @attributes; !$known_attr{$_} && delete $attrs{$_} for keys %attrs; # check that code attributes are coderefs for my $code_attr (qw) { croak "error: Attribute $code_attr must be a code reference" if defined $attrs{$code_attr} and ref $attrs{$code_attr} ne "CODE"; } # default values %attrs = ( backend_collect => sub {}, backend_fork => 0, backend_init => sub {}, heap => {}, input => \*STDIN, output => \*STDOUT, oid_tree => {}, sorted_entries => [], idle_count => 5, refresh => 10, dispatch => { lc(SNMP_PING) => { nargs => 0, code => \&ping }, lc(SNMP_GET) => { nargs => 1, code => \&get_oid }, lc(SNMP_GETNEXT) => { nargs => 1, code => \&getnext_oid }, lc(SNMP_SET) => { nargs => 2, code => \&set_oid }, }, %attrs, ); # create the object with Class::Accessor my $self = $class->SUPER::new(\%attrs); return $self } # # run() # --- sub run { my ($self) = @_; # process command-line arguments Getopt::Long::Configure(qw); GetOptions(\my %options, qw) or croak "fatal: An error occured while processing runtime arguments"; my $name = $::COMMAND || basename($0); openlog($name, "ndelay,pid", "local0"); my ($mode_pass, $mode_passpersist); my $backend_fork = $self->backend_fork; # determine the run mode if (any { defined $options{$_} } "get", "getnext", "set") { $mode_pass = 1; $mode_passpersist = 0; } else { $mode_pass = 0; $mode_passpersist = 1; } # execute the init and collect callback once, except in the case # where the backend run in a separate process unless ($mode_passpersist and $backend_fork) { # initialise the backend eval { $self->backend_init->($self); 1 } or croak "fatal: An error occurred while executing the backend " ."initialisation callback: $@"; # collect the information eval { $self->backend_collect->($self); 1 } or croak "fatal: An error occurred while executing the backend " ."collecting callback: $@"; } # Net-SNMP "pass" mode if ($mode_pass) { for my $op (qw) { if ($options{$op}) { my @args = split /,/, $options{$op}; my $coderef = $self->dispatch->{$op}{code}; my @result = $coderef->($self, @args); $self->output->print(join "\n", @result, ""); } } } # Net-SNMP "pass_persist" mode else { my $needed = 1; my $delay = $self->refresh; my $counter = $self->idle_count; my ($pipe, $child); # if the backend is to be run in a separate process, # create a pipe and fork if ($backend_fork) { $pipe = IO::Pipe->new; $self->backend_pipe($pipe); $child = fork; my $msg = "fatal: can't fork: $!"; syslog err => $msg and die $msg unless defined $child; # child setup is handled in run_backend_loop() goto &run_backend_loop if $child == 0; # parent setup $pipe->reader; # declare this end of the pipe as the reader $pipe->autoflush(1); } my $io = IO::Select->new; $io->add($self->input); $self->output->autoflush(1); if ($backend_fork) { $io->add($pipe); $SIG{CHLD} = sub { $io->remove($pipe); waitpid($child, 0); }; } # main loop while ($needed and $counter > 0) { my $start_time = time; # wait for some input data my @ready = $io->can_read($delay); for my $fh (@ready) { # handle input data from netsnmpd if ($fh == $self->input) { if (my $cmd = <$fh>) { $self->process_cmd(lc($cmd), $fh); $counter = $self->idle_count; } else { $needed = 0 } } # handle input data from the backend process if ($backend_fork and $fh == $pipe) { use bytes; # read a first chunk from the child $fh->sysread(my $buffer, 20); last unless length $buffer; # extract the header my $headline= substr($buffer, 0, index($buffer, "\n")+1, ""); chomp $headline; my %header = map { split /=/, $_, 2 } split /\|/, $headline; # read the date in Storable format my $length = $header{length}; $fh->sysread(my $freezed, $length); $freezed = $buffer.$freezed; # decode the freezed data my $struct = thaw($freezed); $self->add_oid_tree($struct); } } $delay = $delay - (time() - $start_time); if ($delay <= 0) { if (not $backend_fork) { # collect information when the timeout has expired eval { $self->backend_collect->($self); 1 } or croak "fatal: An error occurred while executing " ."the backend collecting callback: $@"; } # reset delay $delay = $self->refresh; $counter--; } } if ($backend_fork) { kill TERM => $child; sleep 1; kill KILL => $child; waitpid($child, 0); } } } # # run_backend_loop() # ---------------- sub run_backend_loop { my ($self) = @_; my $pipe = $self->backend_pipe; $pipe->writer; # declare this end of the pipe as the writer $pipe->autoflush(1); # execute the initialisation callback eval { $self->backend_init->($self); 1 } or croak "fatal: An error occurred while executing the backend " ."initialisation callback: $@"; while (1) { my $start_time = time; # execute the collect callback eval { $self->backend_collect->($self); 1 } or croak "fatal: An error occurred while executing the backend " ."collecting callback: $@"; # freeze the OID tree using Storable use bytes; my $freezed = nfreeze($self->oid_tree); my $length = length $freezed; my $output = "length=$length\n$freezed"; # send it to the parent via the pipe $pipe->syswrite($output); select(undef, undef, undef, .000_001); # wait before next execution my $delay = $self->refresh() - (time() - $start_time); sleep $delay; } } # # add_oid_entry() # ------------- sub add_oid_entry { my ($self, $oid, $type, $value) = @_; croak "error: Unknown type '$type'" unless exists $snmp_ext_type{$type}; $self->oid_tree->{$oid} = [$type => $value]; # need to resort @{$self->sorted_entries} = (); return 1 } # # add_oid_tree() # ------------ sub add_oid_tree { my ($self, $new_tree) = @_; croak "error: Unknown type" if any { !$snmp_ext_type{$_->[0]} } values %$new_tree; my $oid_tree = $self->oid_tree; @{$oid_tree}{keys %$new_tree} = values %$new_tree; # need to resort @{$self->sorted_entries} = (); return 1 } # # dump_oid_tree() # ------------- sub dump_oid_tree { my ($self) = @_; my $oid_tree = $self->oid_tree; my $output = $self->output; for my $oid (sort by_oid keys %$oid_tree) { my ($type, $value) = @{ $oid_tree->{$oid} }; $output->print("$oid ($type) = $value\n"); } } # # ping() # ---- sub ping { return SNMP_PONG } # # get_oid() # ------- sub get_oid { my ($self, $req_oid) = @_; my $oid_tree = $self->oid_tree; my @result = (); if ($oid_tree->{$req_oid}) { my ($type, $value) = @{ $oid_tree->{$req_oid} }; @result = ($req_oid, $type, $value); } else { @result = (SNMP_NONE) } return @result } # # getnext_oid() # ----------- sub getnext_oid { my ($self, $req_oid) = @_; my $next_oid = $self->fetch_next_entry($req_oid) || $self->fetch_first_entry(); return $self->get_oid($next_oid) } # # set_oid() # ------- sub set_oid { my ($self, $req_oid, $value) = @_; return SNMP_NOT_WRITABLE } # # process_cmd() # ----------- # Process and dispatch Net-SNMP commands when in pass_persist mode. # sub process_cmd { my ($self, $cmd, $fh) = @_; my @result = (); chomp $cmd; my $dispatch = $self->dispatch; if (exists $dispatch->{$cmd}) { # read the command arguments my @args = (); my $n = $dispatch->{$cmd}{nargs}; while ($n-- > 0) { chomp(my $arg = <$fh>); push @args, $arg; } # call the command handler my $coderef = $dispatch->{$cmd}{code}; @result = $coderef->($self, @args); } else { @result = SNMP_NONE; } # output the result $self->output->print(join "\n", @result, ""); } # # fetch_next_entry() # ---------------- sub fetch_next_entry { my ($self, $req_oid) = @_; my $entries = $self->sorted_entries; if (!@$entries) { @$entries = HAVE_SORT_KEY_OID ? oidsort(keys %{ $self->oid_tree }) : sort by_oid keys %{ $self->oid_tree }; } # find the index of the current entry my $curr_entry_idx = -1; for my $i (0..$#$entries) { # exact match of the requested entry $curr_entry_idx = $i and last if $entries->[$i] eq $req_oid; # prefix match of the requested entry $curr_entry_idx = $i - 1 and last if $curr_entry_idx == -1 and index($entries->[$i], $req_oid) >= 0; } # get the next entry if it exists, otherwise none my $next_entry_oid = $entries->[$curr_entry_idx + 1] || SNMP_NONE; return $next_entry_oid } # # fetch_first_entry() # ----------------- sub fetch_first_entry { my ($self) = @_; my $entries = $self->sorted_entries; if (!@$entries) { @$entries = HAVE_SORT_KEY_OID ? oidsort(keys %{ $self->oid_tree }) : sort by_oid keys %{ $self->oid_tree }; } my $first_entry_oid = $entries->[0]; return $first_entry_oid } # # by_oid() # ------ # sort() sub-function, for sorting by OID # sub by_oid ($$) { my (undef, @a) = split /\./, $_[0]; my (undef, @b) = split /\./, $_[1]; my $v = 0; $v ||= $a[$_] <=> $b[$_] for 0 .. $#a; return $v } __PACKAGE__ __END__ =head1 NAME SNMP::Extension::PassPersist - Generic pass/pass_persist extension framework for Net-SNMP =head1 VERSION This is the documentation of C version 0.07 =head1 SYNOPSIS Typical setup for a C program: use strict; use SNMP::Extension::PassPersist; # create the object my $extsnmp = SNMP::Extension::PassPersist->new; # add a few OID entries $extsnmp->add_oid_entry($oid, $type, $value); $extsnmp->add_oid_entry($oid, $type, $value); # run the program $extsnmp->run; Typical setup for a C program: use strict; use SNMP::Extension::PassPersist; my $extsnmp = SNMP::Extension::PassPersist->new( backend_collect => \&update_tree ); $extsnmp->run; sub update_tree { my ($self) = @_; # add a serie of OID entries $self->add_oid_entry($oid, $type, $value); ... # or directly add a whole OID tree $self->add_oid_tree(\%oid_tree); } =head1 DESCRIPTION This module is a framework for writing Net-SNMP extensions using the C or C mechanisms. When in C mode, it provides a mechanism to spare ressources by quitting from the main loop after a given number of idle cycles. This module can use C when it is available, for sorting OIDs faster than with the internal pure Perl function. =head1 METHODS =head2 new() Creates a new object. Can be given any attributes as a hash or hashref. See L<"ATTRIBUTES"> for the list of available attributes. B For a C command, most attributes are useless: my $extsnmp = SNMP::Extension::PassPersist->new; For a C command, you'll usually want to at least set the C callback: my $extsnmp = SNMP::Extension::PassPersist->new( backend_collect => \&update_tree, idle_count => 10, # no more than 10 idle cycles refresh => 10, # refresh every 10 sec ); =head2 run() This method does the following things: =over =item * process the command line arguments in order to decide in which mode the program has to be executed =item * call the backend init callback =item * call the backend collect callback a first time =back Then, when in C mode, the corresponding SNMP command is executed, its result is printed on the output filehandle, and C returns. When in C mode, C enters a loop, reading Net-SNMP queries on its input filehandle, processing them, and printing result on its output filehandle. The backend collect callback is called every C seconds. If no query is read from the input after C cycles, C returns. =head2 add_oid_entry(FUNC_OID, FUNC_TYPE, FUNC_VALUE) Add an entry to the OID tree. =head2 add_oid_tree(HASH) Merge an OID tree to the main OID tree, using the same structure as the one of the OID tree itself. =head2 dump_oid_tree() Print a complete listing of the OID tree on the output file handle. =head1 ATTRIBUTES This module's attributes are generated by C, and can therefore be passed as arguments to C or called as object methods. =head2 backend_collect Set the code reference for the I callback. See also L<"CALLBACKS">. =head2 backend_fork When set to true, the backend callbacks will be executed in a separate process. Default value is false. =head2 backend_init Set the code reference for the I callback. See also L<"CALLBACKS">. =head2 backend_pipe Contains the pipe used to communicate with the backend child, when executed in a separate process. =head2 dispatch Gives access to the internal dispatch table, stored as a hash with the following structure: dispatch => { SNMP_CMD => { nargs => NUMBER_ARGS, code => CODEREF }, ... } where the SNMP command is always in lowercase, C gives the number of arguments expected by the command and C the callback reference. You should not modify this table unless you really know what you're doing. =head2 heap Give access to the heap. =head2 idle_count Get/set the number of idle cycles before ending the run loop. =head2 input Get/set the input filehandle. =head2 oid_tree Gives access to the internal OID tree, stored as a hash with the following structure: oid_tree => { FUNC_OID => [ FUNC_TYPE, FUNC_VALUE ], ... } where C is the absolute OID of the SNMP function, C the function type (C<"integer">, C<"counter">, C<"gauge">, etc), and C the function value. You should not directly modify this hash but instead use the appropriate methods for adding OID entries. =head2 output Get/set the output filehandle. =head2 refresh Get/set the refresh delay before calling the backend collect callback to update the OID tree. =head1 CALLBACKS The callbacks are invoked with the corresponding object as first argument, as for a normal method. A heap is available for storing user-defined data. In the specific case of a programm running in C mode with a forked backend, the callbacks are only executed in the child process (the forked backend). The currently implemented callbacks are: =over =item * init This callback is called once, before the first I invocation and before the main loop. It can be accessed and modified through the C attribute. =item * collect This callback is called every C seconds so the user can update the OID tree using the C and C methods. =back =head2 Examples For simple needs, only the I callback needs to be defined: my $extsnmp = SNMP::Extension::PassPersist->new( backend_collect => \&update_tree, ); sub update_tree { my ($self) = @_; # fetch the number of running processes my $nb_proc = @{ Proc::ProcessTable->new->table }; $self->add_oid_entry(".1.3.6.1.4.1.32272.10", gauge", $nb_proc); } A more advanced example is when there is a need to connect to a database, in which case both the I and I callback need to be defined: my $extsnmp = SNMP::Extension::PassPersist->new( backend_init => \&connect_db, backend_collect => \&update_tree, ); sub connect_db { my ($self) = @_; my $heap = $self->heap; # connect to a database my $dbh = DBI->connect($dsn, $user, $password); $heap->{dbh} = $dbh; } sub update_tree { my ($self) = @_; my $heap = $self->heap; # fetch the number of records from a given table my $dbh = $heap->{dbh}; my $sth = $dbh->prepare_cached("SELECT count(*) FROM whatever"); $sth->execute; my ($count) = $sth->fetchrow_array; $self->add_oid_entry(".1.3.6.1.4.1.32272.20", "gauge", $count); } =head1 SEE ALSO L is another pass_persist backend for writing Net-SNMP extensions, but relies on threads. The documentation of Net-SNMP, especially the part on how to configure a C or C extension: =over =item * main site: L =item * configuring a pass or pass_persist extension: L =back =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc SNMP::Extension::PassPersist You can also look for information at: =over =item * Search CPAN L =item * Meta CPAN L =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =back =head1 AUTHOR SEbastien Aperghis-Tramoni, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2008-2011 SEbastien Aperghis-Tramoni, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut SNMP-Extension-PassPersist-0.07/t000755000765000120 012072411115 17105 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/t/00-load.t000444000765000120 32212072411115 20540 0ustar00maddingueadmin000000000000#!perl -T use strict; use Test::More tests => 1; use lib "t/lib"; use_ok( 'SNMP::Extension::PassPersist' ); diag( "Testing SNMP::Extension::PassPersist $SNMP::Extension::PassPersist::VERSION, Perl $], $^X" ); SNMP-Extension-PassPersist-0.07/t/01-api.t000444000765000120 222612072411115 20420 0ustar00maddingueadmin000000000000#!perl -T use strict; use warnings; use Test::More; use lib "t/lib"; # public API my $module = "SNMP::Extension::PassPersist"; my @exported_functions = qw( ); my @class_methods = qw( new ); my @object_methods = qw( backend_init backend_collect idle_count input oid_tree output refresh run add_oid_entry add_oid_tree ping get_oid getnext_oid set_oid process_cmd fetch_next_entry fetch_first_entry ); my @creator_args = (); # tests plan plan tests => 1 + 2 * @exported_functions + 1 * @class_methods + 2 + 2 * @object_methods; # load the module use_ok( $module ); # check functions for my $function (@exported_functions) { can_ok($module, $function); can_ok(__PACKAGE__, $function); } # check class methods for my $methods (@class_methods) { can_ok($module, $methods); } # check object methods my $object = eval { $module->new(@creator_args) }; is( $@, "", "creating a $module object" ); isa_ok( $object, $module, "check that the object" ); for my $method (@object_methods) { can_ok($module, $method); can_ok($object, $method); } SNMP-Extension-PassPersist-0.07/t/10-synopsis-pass.t000444000765000120 203212072411115 22475 0ustar00maddingueadmin000000000000#!perl use strict; use warnings; use Test::More; use lib "t/lib"; use Utils; plan tests => 7; my $module = "SNMP::Extension::PassPersist"; # input data my ($oid, $type, $value) = qw<.1.2.3 integer 42>; my $input = ""; my @args = (-g => $oid); # expected data my %expected_tree = ( $oid => [ $type => $value ], ); my $expected_output = join "\n", $oid, $type, $value, ""; # load the module use_ok($module); # create the object my $extsnmp = eval { $module->new }; is( $@, "", "$module->new" ); isa_ok( $extsnmp, $module, "check that \$extsnmp" ); # add an OID entry eval { $extsnmp->add_oid_entry($oid, $type, $value) }; is( $@, "", "add_oid_entry('$oid', '$type', '$value')" ); is_deeply( $extsnmp->oid_tree, \%expected_tree, "check internal OID tree consistency" ); # execute the main loop local @ARGV = @args; my ($stdin, $stdout) = ( ro_fh(\$input), wo_fh(\my $output) ); $extsnmp->input($stdin); $extsnmp->output($stdout); eval { $extsnmp->run }; is( $@, "", "\$extsnmp->run" ); is( $output, $expected_output, "check the output" ); SNMP-Extension-PassPersist-0.07/t/10-synopsis-passpersist.t000444000765000120 265412072411115 24121 0ustar00maddingueadmin000000000000#!perl use strict; use warnings; use Test::More; use File::Temp (); use IO::File; use lib "t/lib"; use Utils; plan skip_all => "doesn't work under Win32" if $^O =~ /Win32/; plan tests => 7; my $module = "SNMP::Extension::PassPersist"; # input data my ($oid, $type, $value) = qw<.1.2.3 integer 42>; my $input = "get\n$oid\n"; # expected data my %expected_tree = ( $oid => [ $type => $value ], ); my $expected_output = join "\n", $oid, $type, $value, ""; # load the module use_ok($module); # create the object my $extsnmp = eval { $module->new(backend_collect => \&update_tree) }; is( $@, "", "$module->new" ); isa_ok( $extsnmp, $module, "check that \$extsnmp" ); my $i = 1; sub update_tree { my ($self) = @_; return if $i > 1; eval { $self->add_oid_entry($oid, $type, $value) }; is( $@, "", "[$i] update_tree(): add_oid_entry('$oid', '$type', '$value')" ); is_deeply( $self->oid_tree, \%expected_tree, "[$i] update_tree(): check internal OID tree consistency" ); $i++; } # prepare the input and output my $fh = File::Temp->new; $fh->print($input); $fh->close; my ($stdin, $stdout) = ( IO::File->new($fh->filename), wo_fh(\my $output) ); # configure the object for the test $extsnmp->input($stdin); $extsnmp->output($stdout); $extsnmp->idle_count(1); $extsnmp->refresh(1); # execute the main loop eval { $extsnmp->run }; is( $@, "", "\$extsnmp->run" ); is( $output, $expected_output, "check the output" ); SNMP-Extension-PassPersist-0.07/t/11-new.t000444000765000120 310012072411115 20431 0ustar00maddingueadmin000000000000#!perl use strict; use warnings; use Test::More; use lib "t/lib"; use SNMP::Extension::PassPersist; my $module = "SNMP::Extension::PassPersist"; my @cases = ( { attr => [], diag => qr/^$/, }, { attr => [ {} ], diag => qr/^$/, }, { attr => [ 42 ], diag => qr/^error: Odd number of arguments/, }, { attr => [ 1, 2, 3 ], diag => qr/^error: Odd number of arguments/, }, { # unknown attributes are ignored attr => [ foo => "bar" ], diag => qr/^$/, }, { attr => [ { foo => "bar" } ], diag => qr/^$/, }, { attr => [ \my $var ], diag => qr/^error: Don't know how to handle scalar reference/, }, { attr => [ [] ], diag => qr/^error: Don't know how to handle array reference/, }, { attr => [ sub {} ], diag => qr/^error: Don't know how to handle code reference/, }, { # checking that code attributes are correctly checked attr => [ backend_init => sub {} ], diag => qr/^$/, }, { attr => [ backend_init => [] ], diag => qr/^error: Attribute backend_init must be a code reference/, }, { attr => [ backend_init => {} ], diag => qr/^error: Attribute backend_init must be a code reference/, }, ); plan tests => ~~@cases; for my $case (@cases) { my $attr = $case->{attr}; my $diag = $case->{diag}; my $object = eval { $module->new(@$attr) }; like( $@, $diag, "$module->new(".join(", ", @$attr).")" ); } SNMP-Extension-PassPersist-0.07/t/12-run.t000444000765000120 151012072411115 20450 0ustar00maddingueadmin000000000000#!perl use strict; use warnings; use Test::More; use lib "t/lib"; use SNMP::Extension::PassPersist; my $module = "SNMP::Extension::PassPersist"; my $common_part = "fatal: An error occurred while executing the backend"; my @cases = ( { attr => [ backend_init => sub { die "Plonk" } ], args => [], diag => qr/^$common_part initialisation callback: Plonk/, }, { attr => [ backend_collect => sub { die "Plonk" } ], args => [], diag => qr/^$common_part collecting callback: Plonk/, }, ); plan tests => ~~@cases; for my $case (@cases) { my $attr = $case->{attr}; my $args = $case->{args}; my $diag = $case->{diag}; my $object = $module->new(@$attr); eval { $object->run() }; like( $@, $diag, "\$object->run() with \@ARGV=(".join(", ", @$args).")" ); } SNMP-Extension-PassPersist-0.07/t/50-walk.t000444000765000120 226712072411115 20616 0ustar00maddingueadmin000000000000#!perl use strict; use warnings; use Test::More; use lib "t/lib"; plan skip_all => "doesn't work under Win32" if $^O =~ /Win32/; plan skip_all => "JSON not available" unless eval "use JSON; 1"; plan skip_all => "IPC::Run not available" unless eval "use IPC::Run; 1"; # use JSON v2 API even with JSON v1 if (JSON->VERSION < 2.00) { no warnings; *to_json = *JSON::encode = \&JSON::objToJson; *from_json = *JSON::decode = \&JSON::jsonToObj; } plan tests => 3; my @expected = ( { oid => ".1.2.42.1", type => "integer", value => "42", }, { oid => ".1.2.42.2", type => "string", value => "the answer", }, ); my $walker = "eg/pseudo-walk"; my $snmpext = "eg/synopsis-passpersist.pl"; my @cmd = ( $^X, $walker, "--as", "json", "--", ".1.2.42", $^X, "-Ilib", $snmpext ); my ($in, $out, $err) = ("", "", ""); # execute the SNMP extension my $r = IPC::Run::run(\@cmd, \$in, \$out, \$err); ok( $r, "run(@cmd)" ) or diag "exec error: $err"; # decode the JSON output $out =~ s/[\x00-\x1f]//g; # remove all control chars my $tree = eval { from_json($out) }; is( $@, "", "decode the JSON output" ); # check the structure is_deeply( $tree, \@expected, "check the structure" ); SNMP-Extension-PassPersist-0.07/t/90-pod.t000444000765000120 56112072411115 20421 0ustar00maddingueadmin000000000000#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod plan skip_all => "Test::Pod 1.22 required for testing POD" unless eval "use Test::Pod 1.22; 1"; all_pod_files_ok(); if (eval "use Pod::Checker; 1") { my $checker = Pod::Checker->new(-warnings => 1); $checker->parse_from_file($_, \*STDERR) for all_pod_files(); } SNMP-Extension-PassPersist-0.07/t/91-pod-coverage.t000444000765000120 124612072411115 22234 0ustar00maddingueadmin000000000000#!perl use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" unless eval "use Test::Pod::Coverage $min_tpc; 1"; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" unless eval "use Pod::Coverage $min_pc; 1"; all_pod_coverage_ok({ also_private => [qw< ^by_oid$ ^fetch_ ^[gs]et.*oid$ ^ping$ ^process_cmd$ ^run_backend_loop$ >] }); SNMP-Extension-PassPersist-0.07/t/bugs000755000765000120 012072411115 20045 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/t/bugs/cpan-rt-43579.pl000555000765000120 113712072411115 22601 0ustar00maddingueadmin000000000000#!/usr/bin/perl use strict; use warnings; use SNMP::Extension::PassPersist; my $extsnmp = SNMP::Extension::PassPersist->new( backend_collect => \&update_tree, idle_count => 10, # no more than 10 idle cycles refresh => 10, # refresh every 10 sec ); my $oid = ".1.3.6.1.4.1.2021.51."; sub update_tree { $extsnmp->add_oid_entry($oid."1", "string", "TEST"); $extsnmp->add_oid_entry($oid."2.1", "string", "2.1"); $extsnmp->add_oid_entry($oid."2.2", "string", "2.2"); $extsnmp->add_oid_entry($oid."4", "integer", 1); } # run the program $extsnmp->run; SNMP-Extension-PassPersist-0.07/t/bugs/cpan-rt-46256.t000444000765000120 34512072411115 22401 0ustar00maddingueadmin000000000000use strict; use warnings; use Test::More; use SNMP::Extension::PassPersist; plan tests => 1; my $ext = SNMP::Extension::PassPersist->new; eval { $ext->add_oid_tree({ 0 => [ 'counter', 1 ]}) }; is( $@, "", "add_oid_tree()" ); SNMP-Extension-PassPersist-0.07/t/lib000755000765000120 012072411115 17653 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/t/lib/Utils.pm000444000765000120 215012072411115 21444 0ustar00maddingueadmin000000000000use strict; use Carp; use constant USE_IO_STRING => $] <= 5.008; sub ro_fh { my @handles = (); my $i = 1; for my $stringref (@_) { croak "error: argument $i is not a scalarref" unless ref $stringref eq "SCALAR"; my $fh = undef; if (USE_IO_STRING) { require IO::String; $fh = IO::String->new($stringref); } else { open($fh, "<", $stringref) or croak "fatal: Can't read in-memory buffer: $!"; } $i++; push @handles, $fh; } return @handles } sub wo_fh { my @handles = (); my $i = 1; for my $stringref (@_) { croak "error: argument $i is not a scalarref" unless ref $stringref eq "SCALAR"; my $fh = undef; if (USE_IO_STRING) { require IO::String; $fh = IO::String->new($stringref); } else { open($fh, ">", $stringref) or croak "fatal: Can't read in-memory buffer: $!"; } $i++; push @handles, $fh; } return @handles } 1 SNMP-Extension-PassPersist-0.07/t/lib/Sys000755000765000120 012072411115 20431 5ustar00maddingueadmin000000000000SNMP-Extension-PassPersist-0.07/t/lib/Sys/Syslog.pm000444000765000120 7312072411115 22344 0ustar00maddingueadmin000000000000sub openlog { 1 } sub syslog { 1 } sub closelog { 1 } 1