nagios4/contrib/new_mini_epn.c

/*
	new_mini_epn.c

*/

#include <EXTERN.h>
#include <perl.h>
#include "epn_nagios.h"

/*
 * DO_CLEAN must be a pointer to a char string
 */

#define DO_CLEAN "0"

static PerlInterpreter *my_perl = NULL;

/*
 *                                                      <=== Align Right
 *                                                      56 spaces from left margin
 *    Do  N  O  T  use  T  A  B  S  in  #define  code.
 *
 *    Indent level == 4 spaces
 */

#define DO_READLINE                                     \
    "$_ = defined($term) "                              \
    "        ? $term->readline($prompt) "               \
    "        : do    { "                                \
    "                    print $prompt; "               \
    "                    chomp($_ = <>); "              \
    "                    $_; "                          \
    "                }; "                               \
    "die qq(That's all folks.\\n) "                     \
    "    unless $_ && ! /^\\s*$/ ; "                    \
    "$_; "

#define INIT_TERM_READLINE                              \
    "use vars qw($term $prompt $OUT); "                 \
                                                        \
    "eval { require Term::ReadLine; }; "                \
    "unless ($@) { "                                    \
    "    $term = new Term::ReadLine 'new_mini_epn'; "   \
    "} else { "                                         \
    "    warn qq(Install Term::ReadLine for arrow key access to history, filename completion etc.); " \
    "} "                                                \
                                                        \
    "$OUT = $term->OUT "                                \
    "    if defined($term); "                           \
    "$prompt = 'plugin command line: '; "

void run_plugin(char *command_line) {

#ifdef aTHX
	dTHX;
#endif

	SV *plugin_hndlr_cr ;
	STRLEN n_a ;
	int count = 0 ;
	int pclose_result;
	char *plugin_output;
	char fname[128];
	char *args[] = {"", "", "", "", NULL };

	dSP;

	strncpy(fname, command_line, strcspn(command_line, " "));
	fname[strcspn(command_line, " ")] = '\0';

	/*
	 * Arguments passsed to Perl sub Embed::Persistent::run_package
	 */

	/*
	 * filename containing plugin
	 */
	args[0] = fname ;
	/*
	 * Do _not_ cache the compiled plugin
	 */
	args[1] = DO_CLEAN ;
	/*
	 * pointer to plugin arguments
	 */

	args[3] = command_line + strlen(fname) + 1 ;

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(sv_2mortal(newSVpv(args[0], 0)));
	XPUSHs(sv_2mortal(newSVpv(args[1], 0)));
	XPUSHs(sv_2mortal(newSVpv(args[2], 0)));
	XPUSHs(sv_2mortal(newSVpv(args[3], 0)));

	PUTBACK;

	call_pv("Embed::Persistent::eval_file", G_SCALAR | G_EVAL);

	SPAGAIN ;

	if(SvTRUE(ERRSV)) {
		(void) POPs;

		printf("embedded perl compiled plugin %s with error: %s - skipping plugin\n", fname, SvPVX(ERRSV));
		return;
		}
	else {
		plugin_hndlr_cr = newSVsv(POPs);

		PUTBACK ;
		FREETMPS ;
		LEAVE ;
		}
	/*
	 * Push the arguments to Embed::Persistent::run_package onto
	 * the Perl stack.
	 */
	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	XPUSHs(sv_2mortal(newSVpv(args[0], 0)));
	XPUSHs(sv_2mortal(newSVpv(args[1], 0)));
	XPUSHs(plugin_hndlr_cr);
	XPUSHs(sv_2mortal(newSVpv(args[3], 0)));

	PUTBACK;

	count = call_pv("Embed::Persistent::run_package", G_ARRAY);

	SPAGAIN;

	plugin_output = POPpx ;
	pclose_result = POPi ;

	printf("embedded perl plugin return code and output was: %d & %s\n", pclose_result, plugin_output) ;

	PUTBACK;
	FREETMPS;
	LEAVE;

	return ;

	}

SV * my_eval_pv(char *pv) {

	SV* result;

	/*
	 * eval_pv(..., TRUE) means die if Perl traps an error
	 */
	result = eval_pv(pv, TRUE) ;
	return result ;
	}

char * get_command_line(void) {

	/* debug
	 * printf("%s\n", INIT_TERM_READLINE) ;
	 */
	SV *cmd_line ;
	char *command_line ;

	cmd_line	= my_eval_pv(DO_READLINE) ;
	command_line	= SvPVX(cmd_line) ;
	/* command_line	= SvPV(cmd_line, n_a) ; */
	return command_line ;
	}

void init_term_readline(void) {
	(void) my_eval_pv(INIT_TERM_READLINE) ;
	}

void init_embedded_perl(void) {
	char *embedding[] = { "", "p1.pl" };
	/* embedding takes the place of argv[] ($argv[0] is the program name.
	 * - which is not given to Perl).
	 * Note that the number of args (ie the number of elements in embedding
	 * [argc] is the third argument of perl_parse().
	 */
	int exitstatus;
	char buffer[132];

	if((my_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(my_perl);
	exitstatus = perl_parse(my_perl, xs_init, 2, embedding, NULL);
	PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
	/* Why is perl_run() necessary ?
	 * It is needed if the code parsed by perl_parse() has
	 * any runtime semantics (eg code that gets eval'd,
	 * behaviour that depends on constants etc).
	 */
	exitstatus = perl_run(my_perl);

	if(exitstatus) {
		printf("%s\n", "perl_run() failed.");
		exit(1);
		}
	}

void deinit_embedded_perl(void) {

	PL_perl_destruct_level = 0;
	perl_destruct(my_perl);
	perl_free(my_perl);
	}


int main(int argc, char **argv, char **env) {

	init_embedded_perl();
	/* Calls Perl to load and construct a new
	 * Term::ReadLine object.
	 */

	init_term_readline();

	while(1) {
		/*
		 * get_command_line calls Perl to get a scalar from stdin
		 */

		/* Perl Term::ReadLine::readline() method chomps the "\n"
		 * from the end of the input.
		 */
		char *cmd, *end;
		/* Allow any length command line */
		cmd = (get_command_line()) ;

		// Trim leading whitespace
		while(isspace(*cmd)) cmd++;

		// Trim trailing whitespace
		end = cmd + strlen(cmd) - 1;
		while(end > cmd && isspace(*end)) end--;

		// Write new null terminator
		*(end + 1) = 0;

		run_plugin(cmd) ;
		}

	deinit_embedded_perl();
	}