1 /*************************************************
2 * Exim - an Internet mail transport agent *
3 *************************************************/
5 /* Copyright (c) 1998 Malcolm Beattie */
6 /* Copyright (C) 1999 - 2018 Exim maintainers */
8 /* Modified by PH to get rid of the "na" usage, March 1999.
9 Modified further by PH for general tidying for Exim 4.
10 Threaded Perl support added by Stefan Traby, Nov 2002
14 /* This Perl add-on can be distributed under the same terms as Exim itself. */
15 /* See the file NOTICE for conditions of use and distribution. */
24 #define EXIM_TRUE TRUE
27 #define EXIM_FALSE FALSE
30 #define EXIM_DEBUG DEBUG
38 #define ERRSV (GvSV(errgv))
41 /* Some people like very old perl versions, so avoid any build side-effects. */
48 # define EXTERN_C extern
51 EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
54 static PerlInterpreter *interp_perl = 0;
63 croak("Usage: Exim::expand_string(string)");
65 str = expand_string(US SvPV(ST(0), len));
66 ST(0) = sv_newmortal();
68 sv_setpv(ST(0), CCS str);
69 else if (!f.expand_string_forcedfail)
70 croak("syntax error in Exim::expand_string argument: %s",
71 expand_string_message);
79 croak("Usage: Exim::debug_write(string)");
80 debug_printf("%s", US SvPV(ST(0), len));
88 croak("Usage: Exim::log_write(string)");
89 log_write(0, LOG_MAIN, "%s", US SvPV(ST(0), len));
92 static void xs_init(pTHX)
94 char *file = __FILE__;
95 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
96 newXS("Exim::expand_string", xs_expand_string, file);
97 newXS("Exim::debug_write", xs_debug_write, file);
98 newXS("Exim::log_write", xs_log_write, file);
102 init_perl(uschar *startup_code)
105 static char *argv[4] = { "exim-perl" };
109 if (opt_perl_taintmode) argv[argc++] = "-T";
110 argv[argc++] = "/dev/null";
113 assert(sizeof(argv)/sizeof(argv[0]) > argc);
115 if (interp_perl) return 0;
116 interp_perl = perl_alloc();
117 perl_construct(interp_perl);
118 perl_parse(interp_perl, xs_init, argc, argv, 0);
119 perl_run(interp_perl);
123 /*********************************************************************/
124 /* These lines by PH added to make "warn" output go to the Exim log; I
125 hope this doesn't break anything. */
128 "$SIG{__WARN__} = sub { my($s) = $_[0];"
130 "Exim::log_write($s) };", 0);
132 perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR);
134 if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len);
135 /*********************************************************************/
137 sv = newSVpv(CS startup_code, 0);
139 perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR);
141 if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len);
143 setlocale(LC_ALL, "C"); /* In case it got changed */
153 perl_destruct(interp_perl);
154 perl_free(interp_perl);
159 call_perl_cat(gstring * yield, uschar **errstrp, uschar *name, uschar **arg)
169 *errstrp = US"the Perl interpreter has not been started";
176 while (*arg != NULL) XPUSHs(newSVpv(CS (*arg++), 0));
178 items = perl_call_pv(CS name, G_SCALAR|G_EVAL);
184 *errstrp = US SvPV(ERRSV, len);
192 str = US SvPV(sv, len);
193 yield = string_catn(yield, str, (int)len);
197 setlocale(LC_ALL, "C"); /* In case it got changed */