tools/mini_epn.c

   1 /*
   2  *
   3  *  MINI_EPN.C - Mini Embedded Perl Nagios
   4  *  Contributed by Stanley Hopcroft
   5  *  Modified by Douglas Warner
   6  *  Last Modified: 05/02/2002
   7  *
   8  *  This is a sample mini embedded Perl interpreter (hacked out checks.c and
   9  *  perlembed) for use in testing Perl plugins.
  10  *
  11  *  It can be compiled with the following command (see 'man perlembed' for
  12  *  more info):
  13  *
  14  *  gcc -omini_epn mini_epn.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
  15  *
  16  *  NOTES:  The compiled binary needs to be in the same directory as the p1.pl
  17  *  file supplied with Nagios (or vice versa)
  18  *  When using mini_epn to test perl scripts, you must place positional
  19  *  arguments immediately after the file/script and before any arguments
  20  *  processed by Getopt
  21  *
  22  */
  23
  24
  25 #include <EXTERN.h>
  26 #include <perl.h>
  27 #include <fcntl.h>
  28 #include <string.h>
  29
  30 /* include PERL xs_init code for module and C library support */
  31
  32 #if defined(__cplusplus)
  33 #define is_cplusplus
  34 #endif
  35
  36 #ifdef is_cplusplus
  37 extern "C" {
  38 #endif
  39
  40 #define NO_XSLOCKS
  41 #include <XSUB.h>
  42
  43 #ifdef is_cplusplus
  44 }
  45 #  ifndef EXTERN_C
  46 #    define EXTERN_C extern "C"
  47 #  endif
  48 #else
  49 #  ifndef EXTERN_C
  50 #    define EXTERN_C extern
  51 #  endif
  52 #endif
  53
  54
  55 EXTERN_C void xs_init _((void));
  56
  57 EXTERN_C void boot_DynaLoader _((CV* cv));
  58
  59 EXTERN_C void xs_init(void)
  60 {
  61         char *file = __FILE__;
  62         dXSUB_SYS;
  63
  64         /* DynaLoader is a special case */
  65         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
  66 }
  67
  68
  69 static PerlInterpreter *perl = NULL;
  70
  71
  72 int main(int argc, char **argv, char **env)
  73 {
  74         char *embedding[] = { "", "p1.pl" };
  75         char plugin_output[1024];
  76         char buffer[512];
  77         char tmpfname[32];
  78         char fname[32];
  79         char *args[] = {"","0", "", "", NULL };
  80         FILE *fp;
  81
  82         const int command_line_size = 160;
  83         char command_line[command_line_size];
  84         char *ap ;
  85         int exitstatus;
  86         int pclose_result;
  87 #ifdef THREADEDPERL
  88         dTHX;
  89 #endif
  90         dSP;
  91
  92         if ((perl=perl_alloc())==NULL) {
  93                 snprintf(buffer,sizeof(buffer),"Error: Could not allocate memory for embedded Perl interpreter!\n");
  94                 buffer[sizeof(buffer)-1]='\x0';
  95                 printf("%s\n", buffer);
  96                 exit(1);
  97         }
  98         perl_construct(perl);
  99         exitstatus=perl_parse(perl,xs_init,2,embedding,NULL);
 100         if (!exitstatus) {
 101
 102                 exitstatus=perl_run(perl);
 103
 104                 while(printf("Enter file name: ") && fgets(command_line, command_line_size, stdin)) {
 105
 106                         /* call the subroutine, passing it the filename as an argument */
 107
 108                         command_line[strlen(command_line) -1] = '\0';
 109
 110                         strncpy(fname,command_line,strcspn(command_line," "));
 111                         fname[strcspn(command_line," ")] = '\x0';
 112                         args[0] = fname ;
 113                         args[3] = command_line + strlen(fname) + 1 ;
 114
 115                         /* generate a temporary filename to which stdout can be redirected. */
 116                         sprintf(tmpfname,"/tmp/embedded%d",getpid());
 117                         args[2] = tmpfname;
 118
 119                         /* call our perl interpreter to compile and optionally cache the command */
 120                         perl_call_argv("Embed::Persistent::eval_file", G_DISCARD | G_EVAL, args);
 121
 122                         perl_call_argv("Embed::Persistent::run_package", G_DISCARD | G_EVAL, args);
 123
 124                         /* check return status  */
 125                         if(SvTRUE(ERRSV)){
 126                                 pclose_result=-2;
 127                                 printf("embedded perl ran %s with error %s\n",fname,SvPV(ERRSV,PL_na));
 128                         }
 129
 130                         /* read back stdout from script */
 131                         fp=fopen(tmpfname, "r");
 132
 133                         /* default return string in case nothing was returned */
 134                         strcpy(plugin_output,"(No output!)");
 135
 136                         fgets(plugin_output,sizeof(plugin_output)-1,fp);
 137                         plugin_output[sizeof(plugin_output)-1]='\x0';
 138                         fclose(fp);
 139                         unlink(tmpfname);
 140                         printf("embedded perl plugin output was %d,%s\n",pclose_result, plugin_output);
 141
 142                 }
 143
 144         }
 145
 146
 147         PL_perl_destruct_level = 0;
 148         perl_destruct(perl);
 149         perl_free(perl);
 150         exit(exitstatus);
 151 }