X-Git-Url: https://git.exim.org/exim.git/blobdiff_plain/d5b80e59458182b2d557a929a18cb8c70cd56b68..HEAD:/src/src/perl.c

diff --git a/src/src/perl.c b/src/src/perl.c
deleted file mode 100644
index 5f4f0d98d..000000000
--- a/src/src/perl.c
+++ /dev/null
@@ -1,197 +0,0 @@
-/*************************************************
-*     Exim - an Internet mail transport agent    *
-*************************************************/
-
-/* Copyright (c) 1998 Malcolm Beattie */
-
-/* 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>
-#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 (!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;
-}
-
-uschar *
-call_perl_cat(uschar *yield, int *sizep, int *ptrp, 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, sizep, ptrp, str, (int)len);
-  FREETMPS;
-  LEAVE;
-
-  setlocale(LC_ALL, "C");    /* In case it got changed */
-  return yield;
-}
-
-/* End of perl.c */