From: Subhendu Ghosh Date: Thu, 2 May 2002 16:22:13 +0000 (+0000) Subject: updated mini_epn and p1.pl added to plugins distribution X-Git-Url: https://git.tokkee.org/?a=commitdiff_plain;h=bbcaeb1db1666c606a3578d3d24f1618f8c9947c;p=nagiosplug.git updated mini_epn and p1.pl added to plugins distribution git-svn-id: https://nagiosplug.svn.sourceforge.net/svnroot/nagiosplug/nagiosplug/trunk@20 f882894a-f735-0410-b71e-b25c423dba1c --- diff --git a/tools/README b/tools/README new file mode 100644 index 0000000..2279afc --- /dev/null +++ b/tools/README @@ -0,0 +1,8 @@ +$Id$ +The tools subdirectory contains anciliary files that can be used to configure +or test the plugins. + +1. setup - used to get the configuration initialized after a CVS download +2. tango - +3. mini_epn/p1.pl - used to test perl plugins for functionality under embedded + perl diff --git a/tools/mini_epn.c b/tools/mini_epn.c new file mode 100644 index 0000000..cd67538 --- /dev/null +++ b/tools/mini_epn.c @@ -0,0 +1,153 @@ +/* + * + * MINI_EPN.C - Mini Embedded Perl Nagios + * Contributed by Stanley Hopcroft + * Modified by Douglas Warner + * Last Modified: 05/02/2002 + * + * $Id$ + * + * This is a sample mini embedded Perl interpreter (hacked out checks.c and + * perlembed) for use in testing Perl plugins. + * + * It can be compiled with the following command (see 'man perlembed' for + * more info): + * + * gcc -omini_epn mini_epn.c `perl -MExtUtils::Embed -e ccopts -e ldopts` + * + * NOTES: The compiled binary needs to be in the same directory as the p1.pl + * file supplied with Nagios (or vice versa) + * When using mini_epn to test perl scripts, you must place positional + * arguments immediately after the file/script and before any arguments + * processed by Getopt + * + */ + + +#include +#include +#include +#include + +/* include PERL xs_init code for module and C library support */ + +#if defined(__cplusplus) +#define is_cplusplus +#endif + +#ifdef is_cplusplus +extern "C" { +#endif + +#define NO_XSLOCKS +#include + +#ifdef is_cplusplus +} +# ifndef EXTERN_C +# define EXTERN_C extern "C" +# endif +#else +# ifndef EXTERN_C +# define EXTERN_C extern +# endif +#endif + + +EXTERN_C void xs_init _((void)); + +EXTERN_C void boot_DynaLoader _((CV* cv)); + +EXTERN_C void xs_init(void) +{ + char *file = __FILE__; + dXSUB_SYS; + + /* DynaLoader is a special case */ + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); +} + + +static PerlInterpreter *perl = NULL; + + +int main(int argc, char **argv, char **env) +{ + char *embedding[] = { "", "p1.pl" }; + char plugin_output[1024]; + char buffer[512]; + char tmpfname[32]; + char fname[32]; + char *args[] = {"","0", "", "", NULL }; + FILE *fp; + + const int command_line_size = 160; + char command_line[command_line_size]; + char *ap ; + int exitstatus; + int pclose_result; +#ifdef THREADEDPERL + dTHX; +#endif + dSP; + + if ((perl=perl_alloc())==NULL) { + snprintf(buffer,sizeof(buffer),"Error: Could not allocate memory for embedded Perl interpreter!\n"); + buffer[sizeof(buffer)-1]='\x0'; + printf("%s\n", buffer); + exit(1); + } + perl_construct(perl); + exitstatus=perl_parse(perl,xs_init,2,embedding,NULL); + if (!exitstatus) { + + exitstatus=perl_run(perl); + + while(printf("Enter file name: ") && fgets(command_line, command_line_size, stdin)) { + + /* call the subroutine, passing it the filename as an argument */ + + command_line[strlen(command_line) -1] = '\0'; + + strncpy(fname,command_line,strcspn(command_line," ")); + fname[strcspn(command_line," ")] = '\x0'; + args[0] = fname ; + args[3] = command_line + strlen(fname) + 1 ; + + /* generate a temporary filename to which stdout can be redirected. */ + sprintf(tmpfname,"/tmp/embedded%d",getpid()); + args[2] = tmpfname; + + /* call our perl interpreter to compile and optionally cache the command */ + perl_call_argv("Embed::Persistent::eval_file", G_DISCARD | G_EVAL, args); + + perl_call_argv("Embed::Persistent::run_package", G_DISCARD | G_EVAL, args); + + /* check return status */ + if(SvTRUE(ERRSV)){ + pclose_result=-2; + printf("embedded perl ran %s with error %s\n",fname,SvPV(ERRSV,PL_na)); + } + + /* read back stdout from script */ + fp=fopen(tmpfname, "r"); + + /* default return string in case nothing was returned */ + strcpy(plugin_output,"(No output!)"); + + fgets(plugin_output,sizeof(plugin_output)-1,fp); + plugin_output[sizeof(plugin_output)-1]='\x0'; + fclose(fp); + unlink(tmpfname); + printf("embedded perl plugin output was %d,%s\n",pclose_result, plugin_output); + + } + + } + + + PL_perl_destruct_level = 0; + perl_destruct(perl); + perl_free(perl); + exit(exitstatus); +} diff --git a/tools/p1.pl b/tools/p1.pl new file mode 100644 index 0000000..2788dbf --- /dev/null +++ b/tools/p1.pl @@ -0,0 +1,151 @@ + package Embed::Persistent; +# +# Hacked version of the sample code from the perlembedded doco. +# +# Only major changes are to separate the compiling and cacheing from +# the execution so that the cache can be kept in "non-volatile" parent +# process while the execution is done from "volatile" child processes +# and that STDOUT is redirected to a file by means of a tied filehandle +# so that it can be returned to NetSaint in the same way as for +# commands executed via the normal popen method. +# + + use strict; + use vars '%Cache'; + use Symbol qw(delete_package); + + +package OutputTrap; +# +# Methods for use by tied STDOUT in embedded PERL module. +# +# Simply redirects STDOUT to a temporary file associated with the +# current child/grandchild process. +# + +use strict; +# Perl before 5.6 does not seem to have warnings.pm ??? +#use warnings; +use IO::File; + +sub TIEHANDLE { + my ($class, $fn) = @_; + my $handle = new IO::File "> $fn" or die "Cannot open embedded work filei $!\n"; + bless { FH => $handle, Value => 0}, $class; +} + +sub PRINT { + my $self = shift; + my $handle = $self -> {FH}; + print $handle join("",@_); +} + +sub PRINTF { + my $self = shift; + my $fmt = shift; + my $handle = $self -> {FH}; + printf $handle ($fmt,@_); +} + +sub CLOSE { + my $self = shift; + my $handle = $self -> {FH}; + close $handle; +} + + package Embed::Persistent; + + sub valid_package_name { + my($string) = @_; + $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg; + # second pass only for words starting with a digit + $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg; + + # Dress it up as a real package name + $string =~ s|/|::|g; + return "Embed::" . $string; + } + + sub eval_file { + my $filename = shift; + my $delete = shift; + my $pn = substr($filename, rindex($filename,"/")+1); + my $package = valid_package_name($pn); + my $mtime = -M $filename; + if(defined $Cache{$package}{mtime} + && + $Cache{$package}{mtime} <= $mtime) + { + # we have compiled this subroutine already, + # it has not been updated on disk, nothing left to do + #print STDERR "already compiled $package->hndlr\n"; + } + else { + local *FH; + open FH, $filename or die "open '$filename' $!"; + local($/) = undef; + my $sub = ; + close FH; + # cater for routines that expect to get args without prgname + # and for those using @ARGV + $sub = "shift(\@_);\n\@ARGV=\@_;\n" . $sub; + + # cater for scripts that have embedded EOF symbols (__END__) + $sub =~ s/__END__/\;}\n__END__/; + + #wrap the code into a subroutine inside our unique package + my $eval = qq{ + package main; + use subs 'CORE::GLOBAL::exit'; + sub CORE::GLOBAL::exit { die "ExitTrap: \$_[0] ($package)"; } + package $package; sub hndlr { $sub; } + }; + { + # hide our variables within this block + my($filename,$mtime,$package,$sub); + eval $eval; + } + if ($@){ + print STDERR $@."\n"; + die; + } + + #cache it unless we're cleaning out each time + $Cache{$package}{mtime} = $mtime unless $delete; + + } + } + + sub run_package { + my $filename = shift; + my $delete = shift; + my $tmpfname = shift; + my $ar = shift; + my $pn = substr($filename, rindex($filename,"/")+1); + my $package = valid_package_name($pn); + my $res = 0; + + tie (*STDOUT, 'OutputTrap', $tmpfname); + + my @a = split(/ /,$ar); + + eval {$res = $package->hndlr(@a);}; + + if ($@){ + if ($@ =~ /^ExitTrap: /) { + $res = 0; + } else { + # get return code (which may be negative) + if ($@ =~ /^ExitTrap: (-?\d+)/) { + $res = $1; + } else { + $res = 2; + print STDERR "<".$@.">\n"; + } + } + } + untie *STDOUT; + return $res; + } + + 1;