1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
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 <EXTERN.h>
#include <perl.h>
#include <fcntl.h>
#include <string.h>
/* 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 <XSUB.h>
#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);
}
|