perl dynamic module
authorJeremy Harris <jgh146exb@wizmail.org>
Sun, 8 Sep 2024 20:22:41 +0000 (21:22 +0100)
committerJeremy Harris <jgh146exb@wizmail.org>
Sun, 8 Sep 2024 20:22:41 +0000 (21:22 +0100)
16 files changed:
doc/doc-txt/NewStuff
src/OS/Makefile-Base
src/scripts/Configure-Makefile
src/scripts/MakeLinks
src/src/EDITME
src/src/config.h.defaults
src/src/drtables.c
src/src/exim.c
src/src/exim.h
src/src/expand.c
src/src/functions.h
src/src/miscmods/Makefile
src/src/miscmods/perl.c [new file with mode: 0644]
src/src/miscmods/perl_api.h [new file with mode: 0644]
src/src/perl.c [deleted file]
test/runtest

index 935efb59a1d2b4876c98b2fdaf9b20a8f687f574..01326b488276f60ea50ed6ee7e55fa94dec2d418 100644 (file)
@@ -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
 ------------
index 22b56aae5a1363bb359190c60605db81054afbac..d8df296723d9d99a9644e16c146288ad9c84b278 100644 (file)
@@ -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 " "
 
index 4fc917dc9c741963e785abba8e30b94e3d3636b5..df6323f3b592014ad18c3ed958b50cf48d9010d6 100755 (executable)
@@ -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
index a3a3131a217013636cc01da457750817ae29543d..d7441ef0ded7cd2e42969816eb09b420e38e01f5 100755 (executable)
@@ -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 \
index c12d74c35ad4e237203175215e0999d4e376e3f2..757e94746f389d7b208148040546a1b648556c4c 100644 (file)
@@ -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
index 60aacee5b319e6c251e3f7dda35f37c408f79777..e6ded1e8fc0107efedc1fabba02f67a540954844 100644 (file)
@@ -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
index b9d4650f1dc1cef660809a98d992d241ec64db19..8bde476668243b7aedbdcf7477a0de75e3795314 100644 (file)
@@ -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
 }
 
 
index 2349260dfb063cec4253bf82e352a9904ecbbb11..9774281e49911e20d5592312741fa0564163d4c0 100644 (file)
@@ -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;
   }
index a3b7112a6f988a7361fc948b384527c4e2c26e96..771c00df84f9f84113a0d22e6fad18ea9a4f385d 100644 (file)
@@ -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. */
index d9e71897e95d0fefef2e4ab91a9118336bb96356..e1e6e199925d22131e88d0e6a34be7afc8b93d02 100644 (file)
@@ -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
index cb470bcb367c06f8c2994f495a753c47c37b314a..9b645a85faa0c541e8a685e8a9d9a89a902aa7f1 100644 (file)
@@ -19,14 +19,6 @@ are in in fact in separate headers. */
 #include <sys/time.h>
 
 
-#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);
index 8f53088ff0f639fe2c75a9eea7334bc11a2327fe..c1489d6e8a3e5073b55bb2afbf74c4b5e6d2115a 100644 (file)
@@ -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 (file)
index 0000000..9014947
--- /dev/null
@@ -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 <assert.h>
+
+#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 <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+#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 (file)
index 0000000..44fa428
--- /dev/null
@@ -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 (file)
index 2a10452..0000000
+++ /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 <assert.h>
-
-#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 <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
-
-#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 */
index 83659ea192db95041458e639069bee1551cc454e..7226c4b0c12a3ce6c4371a6569749d7f189a49f4 100755 (executable)
@@ -1554,13 +1554,15 @@ RESET_AFTER_EXTRA_LINE_READ:
       <IN>; <IN>; <IN>; <IN>; <IN>; 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