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