From: Jeremy Harris Date: Sun, 8 Sep 2024 20:22:41 +0000 (+0100) Subject: perl dynamic module X-Git-Url: https://git.exim.org/exim.git/commitdiff_plain/142fd50739f5ba92bac4a0162d03d818e78dd3b7 perl dynamic module --- diff --git a/doc/doc-txt/NewStuff b/doc/doc-txt/NewStuff index 935efb59a..01326b488 100644 --- a/doc/doc-txt/NewStuff +++ b/doc/doc-txt/NewStuff @@ -14,9 +14,9 @@ Version 4.98 3. Events smtp:fail:protocol and smtp:fail:syntax - 4. JSON and LDAP lookup support, PAM, RADIUS, SPF, DKIM, DMARC and ARC support, - all the router and authenticator drivers, and all the transport drivers - except smtp, can now be built as loadable modules + 4. JSON and LDAP lookup support, PAM, RADIUS, perl, SPF, DKIM, DMARC and ARC + support, all the router and authenticator drivers, and all the transport + drivers except smtp, can now be built as loadable modules Version 4.98 ------------ diff --git a/src/OS/Makefile-Base b/src/OS/Makefile-Base index 22b56aae5..d8df29672 100644 --- a/src/OS/Makefile-Base +++ b/src/OS/Makefile-Base @@ -522,7 +522,7 @@ OBJ_EXIM = acl.o base64.o child.o crypt16.o daemon.o dbfn.o debug.o deliver.o \ std-crypto.o store.o string.o tls.o tod.o transport.o tree.o verify.o \ xtextencode.o environment.o macro.o \ $(OBJ_LOOKUPS) $(OBJ_ROUTERS) $(OBJ_AUTHS) \ - local_scan.o $(EXIM_PERL) $(OBJ_WITH_CONTENT_SCAN) \ + local_scan.o $(OBJ_WITH_CONTENT_SCAN) \ $(OBJ_EXPERIMENTAL) exim: buildlookups buildauths \ @@ -738,12 +738,6 @@ version.o: $(HDRS) cnumber.h version.h version.c dummies.o: dummies.c -# Compile instructions for perl.o for when EXIM_PERL is set - -perl.o: $(HDRS) perl.c - @echo "$(PERL_CC) perl.c" - $(FE)$(PERL_CC) $(PERL_CCOPTS) $(CFLAGS) $(INCLUDE) -c perl.c - # Compile instructions for the database utility modules exim_dumpdb.o: $(HDRS) exim_dbutil.c @@ -1065,6 +1059,8 @@ buildmisc: config CFLAGS_DYNAMIC="$(CFLAGS_DYNAMIC)" \ LDFLAGS_PARTIAL="$(LDFLAGS_PARTIAL)" HDRS="../version.h $(PHDRS)" \ FE="$(FE)" RANLIB="$(RANLIB)" RM_COMMAND="$(RM_COMMAND)" \ + PERL_CC="$(PERL_CC)" PERL_CCOPTS="$(PERL_CCOPTS)" \ + PERL_CFLAGS="$(PERL_CFLAGS)" PERL_LFLAGS="$(PERL_LFLAGS)" \ INCLUDE="$(INCLUDE) $(IPV6_INCLUDE)" @echo " " diff --git a/src/scripts/Configure-Makefile b/src/scripts/Configure-Makefile index 4fc917dc9..df6323f3b 100755 --- a/src/scripts/Configure-Makefile +++ b/src/scripts/Configure-Makefile @@ -284,11 +284,17 @@ then fi rm -f $mftt -#XXX look for RADIUS in $mft; add a SUPPORT_ + +# look for RADIUS in $mft; add a SUPPORT_ if $egrep -q "^RADIUS_CONFIG_FILE" $mft; then echo "# radius fixup" $egrep -q "^SUPPORT_RADIUS" $mft || echo "SUPPORT_RADIUS=yes" >> $mft fi +# also PERL +if $egrep -q "^EXIM_PERL" $mft; then + echo "# perl fixup" + $egrep -q "^SUPPORT_PERL" $mft || echo "SUPPORT_PERL=yes" >> $mft +fi # make the lookups Makefile with the definitions @@ -309,7 +315,7 @@ done <<-END routers ROUTER ACCEPT DNSLOOKUP IPLITERAL IPLOOKUP MANUALROUTE QUERYPROGRAM REDIRECT transports TRANSPORT APPENDFILE AUTOREPLY LMTP PIPE QUEUEFILE SMTP auths AUTH CRAM_MD5 CYRUS_SASL DOVECOT EXTERNAL GSASL HEIMDAL_GSSAPI PLAINTEXT SPA TLS - miscmods SUPPORT ARC _DKIM DMARC PAM RADIUS SPF + miscmods SUPPORT ARC _DKIM DMARC PAM PERL RADIUS SPF END # See if there is a definition of EXIM_PERL in what we have built so far. @@ -338,10 +344,27 @@ if [ "${EXIM_PERL}" != "" ] ; then exit 1; fi + perl_cc="`$PERL_COMMAND -MConfig -e 'print $Config{cc}'`" + perl_ccopts="`$PERL_COMMAND -MExtUtils::Embed -e ccopts`" + perl_libs="`$PERL_COMMAND -MExtUtils::Embed -e ldopts`" + + # For the dynamic-module build, pull out all the -D & -I into another var, + # and -L (maybe & -l?) to another, both for feed to miscmods + # ending up as SUPPORT_PERL_INCLUDE & SUPPORT_PERL_LIB respectively + + perl_cflags=`PERL_CCOPTS="$perl_ccopts" $PERL_COMMAND \ + -e 'my @list = split(" ", $ENV{PERL_CCOPTS});' \ + -e 'foreach (@list) {print "$_ " if (/^-[DI]/)}'` + perl_lflags=`PERL_LIBS="$perl_libs" $PERL_COMMAND \ + -e 'my @list = split(" ", $ENV{PERL_LIBS});' \ + -e 'foreach (@list) {print "$_ " if (/^-L/)}'` + mv $mft $mftt - echo "PERL_CC=`$PERL_COMMAND -MConfig -e 'print $Config{cc}'`" >>$mft - echo "PERL_CCOPTS=`$PERL_COMMAND -MExtUtils::Embed -e ccopts`" >>$mft - echo "PERL_LIBS=`$PERL_COMMAND -MExtUtils::Embed -e ldopts`" >>$mft + echo "PERL_CC=${perl_cc}" >>$mft + echo "PERL_CCOPTS=${perl_ccopts}" >>$mft + echo "PERL_LIBS=${perl_libs}" >>$mft + echo "PERL_CFLAGS=${perl_cflags}" >>$mft + echo "PERL_LFLAGS=${perl_lflags}" >>$mft echo "" >>$mft cat $mftt >> $mft rm -f $mftt diff --git a/src/scripts/MakeLinks b/src/scripts/MakeLinks index a3a3131a2..d7441ef0d 100755 --- a/src/scripts/MakeLinks +++ b/src/scripts/MakeLinks @@ -103,6 +103,7 @@ for f in dummy.c \ pdkim/pdkim_hash.h pdkim/signing.c pdkim/signing.h \ dmarc.c dmarc.h dmarc_api.h \ pam.c pam_api.h \ + perl.c perl_api.h \ radius.c radius_api.h \ spf.c spf.h spf_api.h do @@ -133,7 +134,7 @@ for f in blob.h dbfunctions.h exim.h functions.h globals.h \ deliver.c directory.c dns.c dnsbl.c drtables.c dummies.c enq.c exim.c \ exim_dbmbuild.c exim_dbutil.c exim_lock.c expand.c filter.c filtertest.c \ globals.c hash.c header.c host.c host_address.c ip.c log.c lss.c match.c md5.c moan.c \ - parse.c perl.c priv.c proxy.c queue.c rda.c readconf.c receive.c retry.c rewrite.c \ + parse.c priv.c proxy.c queue.c rda.c readconf.c receive.c retry.c rewrite.c \ regex_cache.c rfc2047.c route.c search.c setenv.c environment.c \ sieve.c smtp_in.c smtp_out.c spool_in.c spool_out.c std-crypto.c store.c \ string.c tls.c tlscert-gnu.c tlscert-openssl.c tls-cipher-stdname.c \ diff --git a/src/src/EDITME b/src/src/EDITME index c12d74c35..757e94746 100644 --- a/src/src/EDITME +++ b/src/src/EDITME @@ -1069,9 +1069,15 @@ ZCAT_COMMAND=/usr/bin/zcat # use Perl code in Exim's string manipulation language and you have Perl # (version 5.004 or later) installed, set EXIM_PERL to perl.o. Using embedded # Perl costs quite a lot of resources. Only do this if you really need it. +# # EXIM_PERL=perl.o +# For a dynamic module build add also SUPPORT_PERL=2 and SUPPORT_PAM_(INCLUED,LIBS) +#SUPPORT_PERL=2 +#SUPPORT_PERL_INCLUDE=$(PERL_CFLAGS) +#SUPPORT_PERL_LIBS=$(PERL_LFLAGS) -lperl + #------------------------------------------------------------------------------ # Support for dynamically-loaded string expansion functions via ${dlfunc. If diff --git a/src/src/config.h.defaults b/src/src/config.h.defaults index 60aacee5b..e6ded1e8f 100644 --- a/src/src/config.h.defaults +++ b/src/src/config.h.defaults @@ -170,6 +170,7 @@ Do not put spaces between # and the 'define'. /* Required to support dynamic-module build */ #define SUPPORT_ARC #define SUPPORT_DKIM +#define SUPPORT_PERL #define SUPPORT_RADIUS #define SYSLOG_LOG_PID diff --git a/src/src/drtables.c b/src/src/drtables.c index b9d4650f1..8bde47666 100644 --- a/src/src/drtables.c +++ b/src/src/drtables.c @@ -431,16 +431,16 @@ misc_module_info * misc_module_list = NULL; static void misc_mod_add(misc_module_info * mi) { -if (mi->init && mi->init(mi)) - { - DEBUG(D_any) if (mi->lib_vers_report) - debug_printf_indent("%Y", mi->lib_vers_report(NULL)); +mi->next = misc_module_list; +misc_module_list = mi; + +if (mi->init && !mi->init(mi)) + DEBUG(D_any) + debug_printf_indent("module init call failed for %s\n", mi->name); + +DEBUG(D_any) if (mi->lib_vers_report) + debug_printf_indent("%Y", mi->lib_vers_report(NULL)); - mi->next = misc_module_list; - misc_module_list = mi; - } -else DEBUG(D_any) - debug_printf_indent("module init call failed for %s\n", mi->name); /* fprintf(stderr,"misc_mod_add: added %s\n", mi->name); */ } @@ -459,7 +459,7 @@ const char * errormsg; DEBUG(D_any) debug_printf_indent("loading module '%s'\n", name); if (!(dl = mod_open(name, US"miscmod", errstr))) { - DEBUG(D_any) debug_printf_indent(" mod_open: %s\n", *errstr); + DEBUG(D_any) if (errstr) debug_printf_indent(" mod_open: %s\n", *errstr); return NULL; } @@ -753,12 +753,15 @@ extern misc_module_info spf_module_info; #if defined(EXPERIMENTAL_ARC) && (!defined(SUPPORT_ARC) || SUPPORT_ARC!=2) extern misc_module_info arc_module_info; #endif -#if defined(RADIUS_CONFIG_FILE) && (!defined(SUPPORT_RADIUS) || SUPPORT_RADUIS!=2) +#if defined(RADIUS_CONFIG_FILE) && (!defined(SUPPORT_RADIUS) || SUPPORT_RADIUS!=2) extern misc_module_info radius_module_info; #endif #if defined(SUPPORT_PAM) && SUPPORT_PAM!=2 extern misc_module_info pam_module_info; #endif +#if defined(EXIM_PERL) && (!defined(SUPPORT_PERL) || SUPPORT_PERL!=2) +extern misc_module_info perl_module_info; +#endif void init_misc_mod_list(void) @@ -780,12 +783,15 @@ onetime = TRUE; #if defined(EXPERIMENTAL_ARC) && (!defined(SUPPORT_ARC) || SUPPORT_ARC!=2) misc_mod_add(&arc_module_info); #endif -#if defined(RADIUS_CONFIG_FILE) && (!defined(SUPPORT_RADIUS) || SUPPORT_RADUIS!=2) +#if defined(RADIUS_CONFIG_FILE) && (!defined(SUPPORT_RADIUS) || SUPPORT_RADIUS!=2) misc_mod_add(&radius_module_info); #endif #if defined(SUPPORT_PAM) && SUPPORT_PAM!=2 misc_mod_add(&pam_module_info); #endif +#if defined(EXIM_PERL) && (!defined(SUPPORT_PERL) || SUPPORT_PERL!=2) + misc_mod_add(&perl_module_info); +#endif } diff --git a/src/src/exim.c b/src/src/exim.c index 2349260df..9774281e4 100644 --- a/src/src/exim.c +++ b/src/src/exim.c @@ -4499,9 +4499,16 @@ if (perl_start_option != 0) opt_perl_at_start = (perl_start_option > 0); if (opt_perl_at_start && opt_perl_startup != NULL) { - uschar *errstr; + uschar * errstr; + const misc_module_info * mi = misc_mod_find(US"perl", &errstr); + typedef uschar * (*fn_t)(uschar *); + + if (!mi) + exim_fail("exim: error finding perl module: %s\n", errstr); + DEBUG(D_any) debug_printf("Starting Perl interpreter\n"); - if ((errstr = init_perl(opt_perl_startup))) + + if ((errstr = (((fn_t *) mi->functions)[PERL_STARTUP]) (opt_perl_startup))) exim_fail("exim: error in perl_startup code: %s\n", errstr); opt_perl_started = TRUE; } diff --git a/src/src/exim.h b/src/src/exim.h index a3b7112a6..771c00df8 100644 --- a/src/src/exim.h +++ b/src/src/exim.h @@ -564,6 +564,9 @@ config.h, mytypes.h, and store.h, so we don't need to mention them explicitly. #ifdef SUPPORT_PAM # include "miscmods/pam_api.h" #endif +#ifdef EXIM_PERL +# include "miscmods/perl_api.h" +#endif /* The following stuff must follow the inclusion of config.h because it requires various things that are set therein. */ diff --git a/src/src/expand.c b/src/src/expand.c index d9e71897e..e1e6e1999 100644 --- a/src/src/expand.c +++ b/src/src/expand.c @@ -5192,6 +5192,8 @@ while (*s) { uschar * sub_arg[EXIM_PERL_MAX_ARGS + 2]; gstring * new_yield; + const misc_module_info * mi; + uschar * errstr; if (expand_forbid & RDO_PERL) { @@ -5199,6 +5201,13 @@ while (*s) goto EXPAND_FAILED; } + if (!(mi = misc_mod_find(US"perl", &errstr))) + { + expand_string_message = + string_sprintf("failed to locate perl module: %s", errstr); + goto EXPAND_FAILED; + } + switch(read_subs(sub_arg, EXIM_PERL_MAX_ARGS + 1, 1, &s, flags, TRUE, name, &resetok, NULL)) { @@ -5213,6 +5222,8 @@ while (*s) if (!opt_perl_started) { uschar * initerror; + typedef uschar * (*fn_t)(uschar *); + if (!opt_perl_startup) { expand_string_message = US"A setting of perl_startup is needed when " @@ -5220,7 +5231,8 @@ while (*s) goto EXPAND_FAILED; } DEBUG(D_any) debug_printf("Starting Perl interpreter\n"); - if ((initerror = init_perl(opt_perl_startup))) + initerror = (((fn_t *) mi->functions)[PERL_STARTUP]) (opt_perl_startup); + if (initerror) { expand_string_message = string_sprintf("error in perl_startup code: %s\n", initerror); @@ -5232,8 +5244,12 @@ while (*s) /* Call the function */ sub_arg[EXIM_PERL_MAX_ARGS + 1] = NULL; - new_yield = call_perl_cat(yield, &expand_string_message, - sub_arg[0], sub_arg + 1); + { + typedef gstring * (*fn_t)(gstring *, uschar **, uschar *, uschar **); + new_yield = (((fn_t *) mi->functions)[PERL_CAT]) + (yield, &expand_string_message, + sub_arg[0], sub_arg + 1); + } /* NULL yield indicates failure; if the message pointer has been set to NULL, the yield was undef, indicating a forced failure. Otherwise the diff --git a/src/src/functions.h b/src/src/functions.h index cb470bcb3..9b645a85f 100644 --- a/src/src/functions.h +++ b/src/src/functions.h @@ -19,14 +19,6 @@ are in in fact in separate headers. */ #include -#ifdef EXIM_PERL -extern gstring *call_perl_cat(gstring *, uschar **, uschar *, - uschar **) WARN_UNUSED_RESULT; -extern void cleanup_perl(void); -extern uschar *init_perl(uschar *); -#endif - - #ifndef DISABLE_TLS extern const char * std_dh_prime_default(void); diff --git a/src/src/miscmods/Makefile b/src/src/miscmods/Makefile index 8f53088ff..c1489d6e8 100644 --- a/src/src/miscmods/Makefile +++ b/src/src/miscmods/Makefile @@ -38,19 +38,27 @@ dkim.o dkim.so: $(HDRS) dkim.h dkim.c dkim_transport.c \ dmarc.o dmarc.so: $(HDRS) pdkim.h dmarc.h dmarc.c dummy.o: dummy.c pam.o pam.so: $(HDRS) pam.c +perl.o perl.so: $(HDRS) perl.c radius.o radius.so: $(HDRS) radius.c spf.o spf.so: $(HDRS) spf.h spf.c dkim.o: - @echo "$(CC) dkim.c dkim_transport.c pdkim.c signing.c" - $(FE)$(CC) -r $(LDFLAGS_PARTIAL) -o $@ $(CFLAGS) $(INCLUDE) \ - dkim.c dkim_transport.c pdkim.c signing.c + @echo "$(CC) dkim.c dkim_transport.c pdkim.c signing.c" + $(FE)$(CC) -r $(LDFLAGS_PARTIAL) -o $@ $(CFLAGS) $(INCLUDE) \ + dkim.c dkim_transport.c pdkim.c signing.c dkim.so: - @echo "$(CC) -shared dkim.c dkim_transport.c pdkim.c signing.c" - $(FE)$(CC) -DDYNLOOKUP $(CFLAGS_DYNAMIC) -o $@ \ - $(SUPPORT_$*_INCLUDE) $(SUPPORT_$*_LIBS) \ - $(CFLAGS) $(INCLUDE) $(DLFLAGS) \ - dkim.c dkim_transport.c pdkim.c signing.c + @echo "$(CC) -shared dkim.c dkim_transport.c pdkim.c signing.c" + $(FE)$(CC) -DDYNLOOKUP $(CFLAGS_DYNAMIC) -o $@ \ + $(SUPPORT_$*_INCLUDE) $(SUPPORT_$*_LIBS) \ + $(CFLAGS) $(INCLUDE) $(DLFLAGS) \ + dkim.c dkim_transport.c pdkim.c signing.c + +# Compile instructions for static perl.o for when EXIM_PERL is set +# Dynamic is managed all via scripts/Configure-Makefile + +perl.o: + @echo "$(PERL_CC) perl.c" + $(FE)$(PERL_CC) $(PERL_CCOPTS) $(CFLAGS) $(INCLUDE) -c perl.c # End diff --git a/src/src/miscmods/perl.c b/src/src/miscmods/perl.c new file mode 100644 index 000000000..901494743 --- /dev/null +++ b/src/src/miscmods/perl.c @@ -0,0 +1,226 @@ +/************************************************* +* Exim - an Internet mail transport agent * +*************************************************/ + +/* Copyright (c) The Exim Maintainers 1999 - 2022 */ +/* Copyright (c) 1998 Malcolm Beattie */ +/* SPDX-License-Identifier: GPL-2.0-or-later */ + +/* Modified by PH to get rid of the "na" usage, March 1999. + Modified further by PH for general tidying for Exim 4. + Threaded Perl support added by Stefan Traby, Nov 2002 +*/ + + +/* This Perl add-on can be distributed under the same terms as Exim itself. */ +/* See the file NOTICE for conditions of use and distribution. */ + +#include + +#define HINTSDB_H +#define DBFUNCTIONS_H + +#include "../exim.h" + +#define EXIM_TRUE TRUE +#undef TRUE + +#define EXIM_FALSE FALSE +#undef FALSE + +#define EXIM_DEBUG DEBUG +#undef DEBUG + +#include +#include +#include + +#ifndef ERRSV +#define ERRSV (GvSV(errgv)) +#endif + +/* Some people like very old perl versions, so avoid any build side-effects. */ + +#ifndef pTHX +# define pTHX +# define pTHX_ +#endif +#ifndef EXTERN_C +# define EXTERN_C extern +#endif + +EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); + + +static PerlInterpreter *interp_perl = 0; + +XS(xs_expand_string) +{ + dXSARGS; + uschar *str; + STRLEN len; + + if (items != 1) + croak("Usage: Exim::expand_string(string)"); + + str = expand_string(US SvPV(ST(0), len)); + ST(0) = sv_newmortal(); + if (str != NULL) + sv_setpv(ST(0), CCS str); + else if (!f.expand_string_forcedfail) + croak("syntax error in Exim::expand_string argument: %s", + expand_string_message); +} + +XS(xs_debug_write) +{ + dXSARGS; + STRLEN len; + if (items != 1) + croak("Usage: Exim::debug_write(string)"); + debug_printf("%s", US SvPV(ST(0), len)); +} + +XS(xs_log_write) +{ + dXSARGS; + STRLEN len; + if (items != 1) + croak("Usage: Exim::log_write(string)"); + log_write(0, LOG_MAIN, "%s", US SvPV(ST(0), len)); +} + +static void xs_init(pTHX) +{ + char *file = __FILE__; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + newXS("Exim::expand_string", xs_expand_string, file); + newXS("Exim::debug_write", xs_debug_write, file); + newXS("Exim::log_write", xs_log_write, file); +} + +static uschar * +init_perl(uschar *startup_code) +{ + static int argc = 1; + static char *argv[4] = { "exim-perl" }; + SV *sv; + STRLEN len; + + if (opt_perl_taintmode) argv[argc++] = "-T"; + argv[argc++] = "/dev/null"; + argv[argc] = 0; + + assert(sizeof(argv)/sizeof(argv[0]) > argc); + + if (interp_perl) return 0; + interp_perl = perl_alloc(); + perl_construct(interp_perl); + perl_parse(interp_perl, xs_init, argc, argv, 0); + perl_run(interp_perl); + { + dSP; + + /*********************************************************************/ + /* These lines by PH added to make "warn" output go to the Exim log; I + hope this doesn't break anything. */ + + sv = newSVpv( + "$SIG{__WARN__} = sub { my($s) = $_[0];" + "$s =~ s/\\n$//;" + "Exim::log_write($s) };", 0); + PUSHMARK(SP); + perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR); + SvREFCNT_dec(sv); + if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len); + /*********************************************************************/ + + sv = newSVpv(CS startup_code, 0); + PUSHMARK(SP); + perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR); + SvREFCNT_dec(sv); + if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len); + + setlocale(LC_ALL, "C"); /* In case it got changed */ + return NULL; + } +} + +#ifdef notdef +static void +cleanup_perl(void) +{ + if (!interp_perl) + return; + perl_destruct(interp_perl); + perl_free(interp_perl); + interp_perl = 0; +} +#endif + +static gstring * +call_perl_cat(gstring * yield, uschar **errstrp, uschar *name, uschar **arg) +{ + dSP; + SV *sv; + STRLEN len; + uschar *str; + int items; + + if (!interp_perl) + { + *errstrp = US"the Perl interpreter has not been started"; + return 0; + } + + ENTER; + SAVETMPS; + PUSHMARK(SP); + while (*arg != NULL) XPUSHs(newSVpv(CS (*arg++), 0)); + PUTBACK; + items = perl_call_pv(CS name, G_SCALAR|G_EVAL); + SPAGAIN; + sv = POPs; + PUTBACK; + if (SvTRUE(ERRSV)) + { + *errstrp = US SvPV(ERRSV, len); + return NULL; + } + if (!SvOK(sv)) + { + *errstrp = 0; + return NULL; + } + str = US SvPV(sv, len); + yield = string_catn(yield, str, (int)len); + FREETMPS; + LEAVE; + + setlocale(LC_ALL, "C"); /* In case it got changed */ + return yield; +} + + + + +/******************************************************************************/ +/* Module API */ + +static void * perl_functions[] = { + [PERL_STARTUP] = init_perl, + [PERL_CAT] = call_perl_cat, +}; + +misc_module_info perl_module_info = +{ + .name = US"perl", +# ifdef DYNLOOKUP + .dyn_magic = MISC_MODULE_MAGIC, +# endif + + .functions = perl_functions, + .functions_count = nelem(perl_functions), +}; + +/* End of perl.c */ diff --git a/src/src/miscmods/perl_api.h b/src/src/miscmods/perl_api.h new file mode 100644 index 000000000..44fa4288b --- /dev/null +++ b/src/src/miscmods/perl_api.h @@ -0,0 +1,16 @@ +/************************************************* +* Exim - an Internet mail transport agent * +*************************************************/ + +/* Copyright (c) The Exim Maintainers 2024 */ +/* See the file NOTICE for conditions of use and distribution. */ +/* SPDX-License-Identifier: GPL-2.0-or-later */ + +/* API definitions for the perlmodule */ + + +/* Function table entry numbers */ + +#define PERL_STARTUP 0 +#define PERL_CAT 1 +#define PERL_CLEANUP 2 diff --git a/src/src/perl.c b/src/src/perl.c deleted file mode 100644 index 2a10452d3..000000000 --- a/src/src/perl.c +++ /dev/null @@ -1,202 +0,0 @@ -/************************************************* -* Exim - an Internet mail transport agent * -*************************************************/ - -/* Copyright (c) The Exim Maintainers 1999 - 2022 */ -/* Copyright (c) 1998 Malcolm Beattie */ -/* SPDX-License-Identifier: GPL-2.0-or-later */ - -/* Modified by PH to get rid of the "na" usage, March 1999. - Modified further by PH for general tidying for Exim 4. - Threaded Perl support added by Stefan Traby, Nov 2002 -*/ - - -/* This Perl add-on can be distributed under the same terms as Exim itself. */ -/* See the file NOTICE for conditions of use and distribution. */ - -#include - -#define HINTSDB_H -#define DBFUNCTIONS_H - -#include "exim.h" - -#define EXIM_TRUE TRUE -#undef TRUE - -#define EXIM_FALSE FALSE -#undef FALSE - -#define EXIM_DEBUG DEBUG -#undef DEBUG - -#include -#include -#include - -#ifndef ERRSV -#define ERRSV (GvSV(errgv)) -#endif - -/* Some people like very old perl versions, so avoid any build side-effects. */ - -#ifndef pTHX -# define pTHX -# define pTHX_ -#endif -#ifndef EXTERN_C -# define EXTERN_C extern -#endif - -EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); - - -static PerlInterpreter *interp_perl = 0; - -XS(xs_expand_string) -{ - dXSARGS; - uschar *str; - STRLEN len; - - if (items != 1) - croak("Usage: Exim::expand_string(string)"); - - str = expand_string(US SvPV(ST(0), len)); - ST(0) = sv_newmortal(); - if (str != NULL) - sv_setpv(ST(0), CCS str); - else if (!f.expand_string_forcedfail) - croak("syntax error in Exim::expand_string argument: %s", - expand_string_message); -} - -XS(xs_debug_write) -{ - dXSARGS; - STRLEN len; - if (items != 1) - croak("Usage: Exim::debug_write(string)"); - debug_printf("%s", US SvPV(ST(0), len)); -} - -XS(xs_log_write) -{ - dXSARGS; - STRLEN len; - if (items != 1) - croak("Usage: Exim::log_write(string)"); - log_write(0, LOG_MAIN, "%s", US SvPV(ST(0), len)); -} - -static void xs_init(pTHX) -{ - char *file = __FILE__; - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); - newXS("Exim::expand_string", xs_expand_string, file); - newXS("Exim::debug_write", xs_debug_write, file); - newXS("Exim::log_write", xs_log_write, file); -} - -uschar * -init_perl(uschar *startup_code) -{ - static int argc = 1; - static char *argv[4] = { "exim-perl" }; - SV *sv; - STRLEN len; - - if (opt_perl_taintmode) argv[argc++] = "-T"; - argv[argc++] = "/dev/null"; - argv[argc] = 0; - - assert(sizeof(argv)/sizeof(argv[0]) > argc); - - if (interp_perl) return 0; - interp_perl = perl_alloc(); - perl_construct(interp_perl); - perl_parse(interp_perl, xs_init, argc, argv, 0); - perl_run(interp_perl); - { - dSP; - - /*********************************************************************/ - /* These lines by PH added to make "warn" output go to the Exim log; I - hope this doesn't break anything. */ - - sv = newSVpv( - "$SIG{__WARN__} = sub { my($s) = $_[0];" - "$s =~ s/\\n$//;" - "Exim::log_write($s) };", 0); - PUSHMARK(SP); - perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR); - SvREFCNT_dec(sv); - if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len); - /*********************************************************************/ - - sv = newSVpv(CS startup_code, 0); - PUSHMARK(SP); - perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR); - SvREFCNT_dec(sv); - if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len); - - setlocale(LC_ALL, "C"); /* In case it got changed */ - return NULL; - } -} - -void -cleanup_perl(void) -{ - if (!interp_perl) - return; - perl_destruct(interp_perl); - perl_free(interp_perl); - interp_perl = 0; -} - -gstring * -call_perl_cat(gstring * yield, uschar **errstrp, uschar *name, uschar **arg) -{ - dSP; - SV *sv; - STRLEN len; - uschar *str; - int items; - - if (!interp_perl) - { - *errstrp = US"the Perl interpreter has not been started"; - return 0; - } - - ENTER; - SAVETMPS; - PUSHMARK(SP); - while (*arg != NULL) XPUSHs(newSVpv(CS (*arg++), 0)); - PUTBACK; - items = perl_call_pv(CS name, G_SCALAR|G_EVAL); - SPAGAIN; - sv = POPs; - PUTBACK; - if (SvTRUE(ERRSV)) - { - *errstrp = US SvPV(ERRSV, len); - return NULL; - } - if (!SvOK(sv)) - { - *errstrp = 0; - return NULL; - } - str = US SvPV(sv, len); - yield = string_catn(yield, str, (int)len); - FREETMPS; - LEAVE; - - setlocale(LC_ALL, "C"); /* In case it got changed */ - return yield; -} - -/* End of perl.c */ diff --git a/test/runtest b/test/runtest index 83659ea19..7226c4b0c 100755 --- a/test/runtest +++ b/test/runtest @@ -1554,13 +1554,15 @@ RESET_AFTER_EXTRA_LINE_READ: ; ; ; ; ; next; } + # various features can be built as dynamic-load modules + next if /loading module '(?:arc|dkim|dmarc|pam|perl|radius|spf)'$/; + # Not all platforms build with DKIM enabled next if /^DKIM >> Body data for hash, canonicalized/; # Not all platforms build with SPF enabled next if /(^$time_pid?spf_conn_init|spf_compile\.c)/; next if /try option spf_smtp_comment_template$/; - next if /loading module '(?:dkim|dmarc|spf)'$/; next if /^$time_pid?Loaded "(?:dkim|dmarc|spf)"$/; # Not all platforms have sendfile support