Debug: feed startup "whats supported" info through normal debug channel

[exim.git] / src / src / perl.c

diff --git a/src/src/perl.c b/src/src/perl.c
index 5bb7ad3608fd0dd7c312910ffbbe7a6520f35dee..58643f0fa24707009068a5e361b4d4f94ddb33be 100644 (file)
--- a/src/src/perl.c
+++ b/src/src/perl.c
@@ -1,10 +1,9 @@
-/* $Cambridge: exim/src/src/perl.c,v 1.3 2005/01/27 15:00:39 ph10 Exp $ */
-

 /*************************************************
 *     Exim - an Internet mail transport agent    *
 *************************************************/
 
 /* Copyright (c) 1998 Malcolm Beattie */
 /*************************************************
 *     Exim - an Internet mail transport agent    *
 *************************************************/
 
 /* Copyright (c) 1998 Malcolm Beattie */

+/* Copyright (C) 1999 - 2018  Exim maintainers */

 
 /* Modified by PH to get rid of the "na" usage, March 1999.
    Modified further by PH for general tidying for Exim 4.
 
 /* Modified by PH to get rid of the "na" usage, March 1999.
    Modified further by PH for general tidying for Exim 4.


@@ -15,6 +14,7 @@
 /* This Perl add-on can be distributed under the same terms as Exim itself. */
 /* See the file NOTICE for conditions of use and distribution. */
 
 /* 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>

 #include "exim.h"
 
 #define EXIM_TRUE TRUE
 #include "exim.h"
 
 #define EXIM_TRUE TRUE


@@ -61,8 +61,8 @@ XS(xs_expand_string)
   str = expand_string(US SvPV(ST(0), len));
   ST(0) = sv_newmortal();
   if (str != NULL)
   str = expand_string(US SvPV(ST(0), len));
   ST(0) = sv_newmortal();
   if (str != NULL)

-    sv_setpv(ST(0), (const char *) str);
-  else if (!expand_string_forcedfail)
+    sv_setpv(ST(0), CCS  str);
+  else if (!f.expand_string_forcedfail)

     croak("syntax error in Exim::expand_string argument: %s",
       expand_string_message);
 }
     croak("syntax error in Exim::expand_string argument: %s",
       expand_string_message);
 }


@@ -97,11 +97,17 @@ static void  xs_init(pTHX)
 uschar *
 init_perl(uschar *startup_code)
 {
 uschar *
 init_perl(uschar *startup_code)
 {

-  static int argc = 2;
-  static char *argv[3] = { "exim-perl", "/dev/null", 0 };
+  static int argc = 1;
+  static char *argv[4] = { "exim-perl" };

   SV *sv;
   STRLEN len;
 
   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);
   if (interp_perl) return 0;
   interp_perl = perl_alloc();
   perl_construct(interp_perl);


@@ -113,22 +119,24 @@ init_perl(uschar *startup_code)
     /*********************************************************************/
     /* These lines by PH added to make "warn" output go to the Exim log; I
     hope this doesn't break anything. */
     /*********************************************************************/
     /* 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];"
     sv = newSVpv(
       "$SIG{__WARN__} = sub { my($s) = $_[0];"

-      "$s =~ s/\\n$//;" 
+      "$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);
     /*********************************************************************/
       "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);
     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;
     }
 }
     return NULL;
     }
 }


@@ -143,9 +151,8 @@ cleanup_perl(void)
   interp_perl = 0;
 }
 
   interp_perl = 0;
 }
 

-uschar *
-call_perl_cat(uschar *yield, int *sizep, int *ptrp, uschar **errstrp,
-  uschar *name, uschar **arg)
+gstring *
+call_perl_cat(gstring * yield, uschar **errstrp, uschar *name, uschar **arg)

 {
   dSP;
   SV *sv;
 {
   dSP;
   SV *sv;


@@ -179,10 +186,10 @@ call_perl_cat(uschar *yield, int *sizep, int *ptrp, uschar **errstrp,
     return NULL;
     }
   str = US SvPV(sv, len);
     return NULL;
     }
   str = US SvPV(sv, len);

-  yield = string_cat(yield, sizep, ptrp, str, (int)len);
+  yield = string_catn(yield, str, (int)len);

   FREETMPS;
   LEAVE;
   FREETMPS;
   LEAVE;

-  
+

   setlocale(LC_ALL, "C");    /* In case it got changed */
   return yield;
 }
   setlocale(LC_ALL, "C");    /* In case it got changed */
   return yield;
 }