Adding upstream version 1:9.16.44.upstream/1%9.16.44upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

8 files changed, 1246 insertions, 0 deletions

diff --git a/contrib/dlz/modules/perl/Makefile b/contrib/dlz/modules/perl/Makefile
new file mode 100644
index 0000000..ec99e00
--- /dev/null
+++ b/contrib/dlz/modules/perl/Makefile
@@ -0,0 +1,63 @@
+# Copyright Internet Systems Consortium, Inc. ("ISC")
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, you can obtain one at https://mozilla.org/MPL/2.0/.
+
+# Copyright (C) Stichting NLnet, Netherlands, stichting@nlnet.nl.
+# Copyright (C) John Eaglesham
+#
+# The development of Dynamically Loadable Zones (DLZ) for Bind 9 was
+# conceived and contributed by Rob Butler.
+#
+# SPDX-License-Identifier: ISC and MPL-2.0
+#
+# Permission to use, copy, modify, and distribute this software for any purpose
+# with or without fee is hereby granted, provided that the above copyright
+# notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND STICHTING NLNET DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL STICHTING NLNET BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
+# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+# For building the dlz_perl_driver driver we don't use
+# the bind9 build structure as the aim is to provide an
+# perl_driver that is separable from the bind9 source tree
+
+CFLAGS += -fPIC -O2 -I../include
+FLAGS_PERL ?= perl
+LIBNAME = dlz_perl_driver.so
+
+all: $(LIBNAME)
+
+dlz_perl_driver.o: dlz_perl_driver.c
+	$(CC) $(CFLAGS) `${FLAGS_PERL} -MExtUtils::Embed -e ccopts` -c -o dlz_perl_driver.o dlz_perl_driver.c
+
+
+dlz_perl_callback_clientinfo.c: dlz_perl_callback_clientinfo.xs
+	${FLAGS_PERL} `${FLAGS_PERL} -MConfig -le 'print $$Config{privlibexp}'`/ExtUtils/xsubpp -prototypes -typemap `${FLAGS_PERL} -MConfig -le 'print $$Config{privlibexp}'`/ExtUtils/typemap dlz_perl_callback_clientinfo.xs > dlz_perl_callback_clientinfo.c
+
+dlz_perl_callback_clientinfo.o: dlz_perl_callback_clientinfo.c
+	$(CC) $(CFLAGS) `${FLAGS_PERL} -MExtUtils::Embed -e ccopts` -c -o dlz_perl_callback_clientinfo.o dlz_perl_callback_clientinfo.c
+
+
+dlz_perl_callback.c: dlz_perl_callback.xs
+	${FLAGS_PERL} `${FLAGS_PERL} -MConfig -le 'print $$Config{privlibexp}'`/ExtUtils/xsubpp -prototypes -typemap `${FLAGS_PERL} -MConfig -le 'print $$Config{privlibexp}'`/ExtUtils/typemap dlz_perl_callback.xs > dlz_perl_callback.c
+
+dlz_perl_callback.o: dlz_perl_callback.c
+	$(CC) $(CFLAGS) `${FLAGS_PERL} -MExtUtils::Embed -e ccopts` -c -o dlz_perl_callback.o dlz_perl_callback.c
+
+
+$(LIBNAME): dlz_perl_driver.o dlz_perl_callback_clientinfo.o dlz_perl_callback.o
+	$(CC) $(LDFLAGS) -shared -o $(LIBNAME) dlz_perl_driver.o dlz_perl_callback_clientinfo.o dlz_perl_callback.o `${FLAGS_PERL} -MExtUtils::Embed -e ldopts`
+
+clean:
+	rm -f dlz_perl_driver.o dlz_perl_driver.so dlz_perl_callback_clientinfo.c dlz_perl_callback_clientinfo.o dlz_perl_callback.c dlz_perl_callback.o
+
+install: dlz_perl_driver.so
+	mkdir -p $(DESTDIR)$(libdir)
+	install dlz_perl_driver.so $(DESTDIR)$(libdir)
diff --git a/contrib/dlz/modules/perl/README b/contrib/dlz/modules/perl/README
new file mode 100644
index 0000000..324054a
--- /dev/null
+++ b/contrib/dlz/modules/perl/README
@@ -0,0 +1,38 @@
+<!--
+Copyright Internet Systems Consortium, Inc. ("ISC")
+
+This Source Code Form is subject to the terms of the Mozilla Public
+License, v. 2.0. If a copy of the MPL was not distributed with this
+file, you can obtain one at https://mozilla.org/MPL/2.0/.
+
+Copyright (C) Stichting NLnet, Netherlands, stichting@nlnet.nl.
+Copyright (C) John Eaglesham
+
+The development of Dynamically Loadable Zones (DLZ) for Bind 9 was
+conceived and contributed by Rob Butler.
+
+SPDX-License-Identifier: ISC and MPL-2.0
+
+Permission to use, copy, modify, and distribute this software for any purpose
+with or without fee is hereby granted, provided that the above copyright
+notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND STICHTING NLNET DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL STICHTING NLNET BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
+OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+-->
+
+
+BIND 9 DLZ Perl module (bind-dlz-tools)
+
+Written by John Eaglesham <dns@8192.net>
+
+A dynamically loadable zone (DLZ) plugin embedding a Perl
+interpreter in BIND, allowing Perl scripts to be written to
+integrate with BIND and serve DNS data.
+
+More information/updates at http://bind-dlz-tools.sourceforge.net/
diff --git a/contrib/dlz/modules/perl/dlz_perl_callback.xs b/contrib/dlz/modules/perl/dlz_perl_callback.xs
new file mode 100644
index 0000000..0b9f504
--- /dev/null
+++ b/contrib/dlz/modules/perl/dlz_perl_callback.xs
@@ -0,0 +1,88 @@
+/*
+ * Copyright (C) Internet Systems Consortium, Inc. ("ISC")
+ *
+ * SPDX-License-Identifier: MPL-2.0 and ISC
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, you can obtain one at https://mozilla.org/MPL/2.0/.
+ */
+
+/*
+ * Copyright (C) Stichting NLnet, Netherlands, stichting@nlnet.nl.
+ * Copyright (C) John Eaglesham
+ *
+ * The development of Dynamically Loadable Zones (DLZ) for Bind 9 was
+ * conceived and contributed by Rob Butler.
+ *
+ * Permission to use, copy, modify, and distribute this software for any purpose
+ * with or without fee is hereby granted, provided that the above copyright
+ * notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+ * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+ * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+ * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+ * OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+ * PERFORMANCE OF THIS SOFTWARE.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "dlz_perl_driver.h"
+
+#include <dlz_minimal.h>
+
+/* And some XS code. */
+MODULE = DLZ_Perl	   PACKAGE = DLZ_Perl
+
+int
+LOG_INFO()
+	CODE:
+		RETVAL = ISC_LOG_INFO;
+	OUTPUT:
+		RETVAL
+
+int
+LOG_NOTICE()
+	CODE:
+		RETVAL = ISC_LOG_NOTICE;
+	OUTPUT:
+		RETVAL
+
+int
+LOG_WARNING()
+	CODE:
+		RETVAL = ISC_LOG_WARNING;
+	OUTPUT:
+		RETVAL
+
+int
+LOG_ERROR()
+	CODE:
+		RETVAL = ISC_LOG_ERROR;
+	OUTPUT:
+		RETVAL
+
+int
+LOG_CRITICAL()
+	CODE:
+		RETVAL = ISC_LOG_CRITICAL;
+	OUTPUT:
+		RETVAL
+
+
+void
+log(opaque, level, msg)
+	IV opaque
+	int level
+	char *msg
+
+	PREINIT:
+		log_t *log = (log_t *) opaque;
+
+	CODE:
+		log( level, msg );
+
diff --git a/contrib/dlz/modules/perl/dlz_perl_callback_clientinfo.xs b/contrib/dlz/modules/perl/dlz_perl_callback_clientinfo.xs
new file mode 100644
index 0000000..22aec66
--- /dev/null
+++ b/contrib/dlz/modules/perl/dlz_perl_callback_clientinfo.xs
@@ -0,0 +1,94 @@
+/*
+ * Copyright (C) Internet Systems Consortium, Inc. ("ISC")
+ *
+ * SPDX-License-Identifier: MPL-2.0 and ISC
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, you can obtain one at https://mozilla.org/MPL/2.0/.
+ */
+
+/*
+ * Copyright (C) Stichting NLnet, Netherlands, stichting@nlnet.nl.
+ * Copyright (C) John Eaglesham
+ *
+ * The development of Dynamically Loadable Zones (DLZ) for Bind 9 was
+ * conceived and contributed by Rob Butler.
+ *
+ * Permission to use, copy, modify, and distribute this software for any purpose
+ * with or without fee is hereby granted, provided that the above copyright
+ * notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+ * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+ * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+ * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+ * OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+ * PERFORMANCE OF THIS SOFTWARE.
+ */
+
+#define ADDR_BUF_LEN INET6_ADDRSTRLEN
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "dlz_perl_driver.h"
+
+#include <dlz_minimal.h>
+
+/* And some XS code. */
+MODULE = DLZ_Perl::clientinfo	   PACKAGE = DLZ_Perl::clientinfo
+
+PROTOTYPES: DISABLE
+
+void
+sourceip(opaque)
+	SV *opaque
+
+	PREINIT:
+		const char *ret;
+		char addr_buf[ADDR_BUF_LEN];
+		int port;
+		isc_sockaddr_t *src;
+		dlz_perl_clientinfo_opaque *ci;
+		I32 wantarray = GIMME_V;
+
+	PPCODE:
+		if (!SvTRUE(opaque) || !SvIOK(opaque)) XSRETURN_EMPTY;
+
+                /*
+                 * Safe, because Perl guarantees that an IV (the type we
+                 * pass into DLZ functions who pass it here) is able to
+                 * hold a pointer.
+                 */
+		ci = (dlz_perl_clientinfo_opaque *) SvIV(opaque);
+		if (wantarray == G_VOID || ci->methods == NULL ||
+			ci->methods->version - ci->methods->age <
+			DNS_CLIENTINFOMETHODS_VERSION)
+			XSRETURN_EMPTY;
+
+		ci->methods->sourceip(ci->clientinfo, &src);
+
+		switch (src->type.sa.sa_family) {
+			case AF_INET:
+				port = ntohs(src->type.sin.sin_port);
+				ret = inet_ntop(AF_INET,
+                                                &src->type.sin.sin_addr,
+                                                addr_buf, ADDR_BUF_LEN);
+				break;
+			case AF_INET6:
+				port = ntohs(src->type.sin6.sin6_port);
+				ret = inet_ntop(AF_INET6,
+                                                &src->type.sin6.sin6_addr,
+                                                addr_buf, ADDR_BUF_LEN);
+				break;
+			default:
+				ret = NULL;
+		}
+
+		if (ret == NULL) XSRETURN_EMPTY;
+
+		XPUSHs(sv_2mortal(newSVpv(addr_buf, strlen(addr_buf))));
+		if (wantarray == G_ARRAY) XPUSHs(sv_2mortal(newSViv(port)));
+
diff --git a/contrib/dlz/modules/perl/dlz_perl_driver.c b/contrib/dlz/modules/perl/dlz_perl_driver.c
new file mode 100644
index 0000000..b99b296
--- /dev/null
+++ b/contrib/dlz/modules/perl/dlz_perl_driver.c
@@ -0,0 +1,715 @@
+/*
+ * Copyright (C) Internet Systems Consortium, Inc. ("ISC")
+ *
+ * SPDX-License-Identifier: MPL-2.0 and ISC
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, you can obtain one at https://mozilla.org/MPL/2.0/.
+ */
+
+/*
+ * Copyright (C) Stichting NLnet, Netherlands, stichting@nlnet.nl.
+ * Copyright (C) John Eaglesham
+ *
+ * The development of Dynamically Loadable Zones (DLZ) for Bind 9 was
+ * conceived and contributed by Rob Butler.
+ *
+ * Permission to use, copy, modify, and distribute this software for any purpose
+ * with or without fee is hereby granted, provided that the above copyright
+ * notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+ * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+ * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+ * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+ * OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+ * PERFORMANCE OF THIS SOFTWARE.
+ */
+
+#include "dlz_perl_driver.h"
+#include <EXTERN.h>
+#include <perl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <dlz_minimal.h>
+
+#define BUF_LEN 64 /* Should be big enough, right? hah */
+
+/* Enable debug logging? */
+#if 0
+#define carp(...) cd->log(ISC_LOG_INFO, __VA_ARGS__);
+#else /* if 0 */
+#define carp(...)
+#endif /* if 0 */
+
+#ifndef MULTIPLICITY
+/* This is a pretty terrible work-around for handling HUP/rndc reconfig, but
+ * the way BIND/DLZ handles reloads causes it to create a second back end
+ * before removing the first. In the case of a single global interpreter,
+ * serious problems arise. We can hack around this, but it's much better to do
+ * it properly and link against a perl compiled with multiplicity. */
+static PerlInterpreter *global_perl = NULL;
+static int global_perl_dont_free = 0;
+#endif /* ifndef MULTIPLICITY */
+
+typedef struct config_data {
+	PerlInterpreter *perl;
+	char *perl_source;
+	SV *perl_class;
+
+	/* Functions given to us by bind9 */
+	log_t *log;
+	dns_sdlz_putrr_t *putrr;
+	dns_sdlz_putnamedrr_t *putnamedrr;
+	dns_dlz_writeablezone_t *writeable_zone;
+} config_data_t;
+
+/* Note, this code generates warnings due to lost type qualifiers.  This code
+ * is (almost) verbatim from perlembed, and is known to work correctly despite
+ * the warnings.
+ */
+EXTERN_C void xs_init(pTHX);
+EXTERN_C void
+boot_DynaLoader(pTHX_ CV *cv);
+EXTERN_C void
+boot_DLZ_Perl__clientinfo(pTHX_ CV *cv);
+EXTERN_C void
+boot_DLZ_Perl(pTHX_ CV *cv);
+EXTERN_C void
+xs_init(pTHX) {
+	const char *file = __FILE__;
+	dXSUB_SYS;
+
+	/* DynaLoader is a special case */
+	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+	newXS("DLZ_Perl::clientinfo::bootstrap", boot_DLZ_Perl__clientinfo,
+	      file);
+	newXS("DLZ_Perl::bootstrap", boot_DLZ_Perl, file);
+}
+
+/*
+ * methods
+ */
+
+/*
+ * remember a helper function, from the bind9 dlz_dlopen driver
+ */
+static void
+b9_add_helper(config_data_t *state, const char *helper_name, void *ptr) {
+	if (strcmp(helper_name, "log") == 0) {
+		state->log = ptr;
+	}
+	if (strcmp(helper_name, "putrr") == 0) {
+		state->putrr = ptr;
+	}
+	if (strcmp(helper_name, "putnamedrr") == 0) {
+		state->putnamedrr = ptr;
+	}
+	if (strcmp(helper_name, "writeable_zone") == 0) {
+		state->writeable_zone = ptr;
+	}
+}
+
+int
+dlz_version(unsigned int *flags) {
+	UNUSED(flags);
+	return (DLZ_DLOPEN_VERSION);
+}
+
+isc_result_t
+dlz_allnodes(const char *zone, void *dbdata, dns_sdlzallnodes_t *allnodes) {
+	config_data_t *cd = (config_data_t *)dbdata;
+	isc_result_t retval;
+	int rrcount, r;
+	SV *record_ref;
+	SV **rr_name;
+	SV **rr_type;
+	SV **rr_ttl;
+	SV **rr_data;
+#ifdef MULTIPLICITY
+	PerlInterpreter *my_perl = cd->perl;
+#endif /* ifdef MULTIPLICITY */
+	dSP;
+
+	PERL_SET_CONTEXT(cd->perl);
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(cd->perl_class);
+	XPUSHs(sv_2mortal(newSVpv(zone, 0)));
+	PUTBACK;
+
+	carp("DLZ Perl: Calling allnodes for zone %s", zone);
+	rrcount = call_method("allnodes", G_ARRAY | G_EVAL);
+	carp("DLZ Perl: Call to allnodes returned rrcount of %i", rrcount);
+
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		(void)POPs;
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl: allnodes for zone %s died in eval: %s", zone,
+			SvPV_nolen(ERRSV));
+		retval = ISC_R_FAILURE;
+		goto CLEAN_UP_AND_RETURN;
+	}
+
+	if (!rrcount) {
+		retval = ISC_R_NOTFOUND;
+		goto CLEAN_UP_AND_RETURN;
+	}
+
+	retval = ISC_R_SUCCESS;
+	r = 0;
+	while (r++ < rrcount) {
+		record_ref = POPs;
+		if ((!SvROK(record_ref)) ||
+		    (SvTYPE(SvRV(record_ref)) != SVt_PVAV))
+		{
+			cd->log(ISC_LOG_ERROR,
+				"DLZ Perl: allnodes for zone %s "
+				"returned an invalid value "
+				"(expected array of arrayrefs)",
+				zone);
+			retval = ISC_R_FAILURE;
+			break;
+		}
+
+		record_ref = SvRV(record_ref);
+
+		rr_name = av_fetch((AV *)record_ref, 0, 0);
+		rr_type = av_fetch((AV *)record_ref, 1, 0);
+		rr_ttl = av_fetch((AV *)record_ref, 2, 0);
+		rr_data = av_fetch((AV *)record_ref, 3, 0);
+
+		if (rr_name == NULL || rr_type == NULL || rr_ttl == NULL ||
+		    rr_data == NULL)
+		{
+			cd->log(ISC_LOG_ERROR,
+				"DLZ Perl: allnodes for zone %s "
+				"returned an array that was missing data",
+				zone);
+			retval = ISC_R_FAILURE;
+			break;
+		}
+
+		carp("DLZ Perl: Got record %s/%s = %s", SvPV_nolen(*rr_name),
+		     SvPV_nolen(*rr_type), SvPV_nolen(*rr_data));
+		retval = cd->putnamedrr(allnodes, SvPV_nolen(*rr_name),
+					SvPV_nolen(*rr_type), SvIV(*rr_ttl),
+					SvPV_nolen(*rr_data));
+		if (retval != ISC_R_SUCCESS) {
+			cd->log(ISC_LOG_ERROR,
+				"DLZ Perl: putnamedrr in allnodes "
+				"for zone %s failed with code %i "
+				"(did lookup return invalid record data?)",
+				zone, retval);
+			break;
+		}
+	}
+
+CLEAN_UP_AND_RETURN:
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	carp("DLZ Perl: Returning from allnodes, r = %i, retval = %i", r,
+	     retval);
+
+	return (retval);
+}
+
+isc_result_t
+dlz_allowzonexfr(void *dbdata, const char *name, const char *client) {
+	config_data_t *cd = (config_data_t *)dbdata;
+	int r;
+	isc_result_t retval;
+#ifdef MULTIPLICITY
+	PerlInterpreter *my_perl = cd->perl;
+#endif /* ifdef MULTIPLICITY */
+	dSP;
+
+	PERL_SET_CONTEXT(cd->perl);
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(cd->perl_class);
+	XPUSHs(sv_2mortal(newSVpv(name, 0)));
+	XPUSHs(sv_2mortal(newSVpv(client, 0)));
+	PUTBACK;
+
+	r = call_method("allowzonexfr", G_SCALAR | G_EVAL);
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		/*
+		 * On error there's an undef at the top of the stack. Pop
+		 * it away so we don't leave junk on the stack for the next
+		 * caller.
+		 */
+		(void)POPs;
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl: allowzonexfr died in eval: %s",
+			SvPV_nolen(ERRSV));
+		retval = ISC_R_FAILURE;
+	} else if (r == 0) {
+		/* Client returned nothing -- zone not found. */
+		retval = ISC_R_NOTFOUND;
+	} else if (r > 1) {
+		/* Once again, clean out the stack when possible. */
+		while (r--) {
+			POPi;
+		}
+		cd->log(ISC_LOG_ERROR, "DLZ Perl: allowzonexfr returned too "
+				       "many parameters!");
+		retval = ISC_R_FAILURE;
+	} else {
+		/*
+		 * Client returned true/false -- we're authoritative for
+		 * the zone.
+		 */
+		r = POPi;
+		if (r) {
+			retval = ISC_R_SUCCESS;
+		} else {
+			retval = ISC_R_NOPERM;
+		}
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+	return (retval);
+}
+
+#if DLZ_DLOPEN_VERSION < 3
+isc_result_t
+dlz_findzonedb(void *dbdata, const char *name)
+#else  /* if DLZ_DLOPEN_VERSION < 3 */
+isc_result_t
+dlz_findzonedb(void *dbdata, const char *name, dns_clientinfomethods_t *methods,
+	       dns_clientinfo_t *clientinfo)
+#endif /* if DLZ_DLOPEN_VERSION < 3 */
+{
+	config_data_t *cd = (config_data_t *)dbdata;
+	int r;
+	isc_result_t retval;
+#ifdef MULTIPLICITY
+	PerlInterpreter *my_perl = cd->perl;
+#endif /* ifdef MULTIPLICITY */
+
+#if DLZ_DLOPEN_VERSION >= 3
+	UNUSED(methods);
+	UNUSED(clientinfo);
+#endif /* if DLZ_DLOPEN_VERSION >= 3 */
+
+	dSP;
+	carp("DLZ Perl: findzone looking for '%s'", name);
+
+	PERL_SET_CONTEXT(cd->perl);
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(cd->perl_class);
+	XPUSHs(sv_2mortal(newSVpv(name, 0)));
+	PUTBACK;
+
+	r = call_method("findzone", G_SCALAR | G_EVAL);
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		/*
+		 * On error there's an undef at the top of the stack. Pop
+		 * it away so we don't leave junk on the stack for the next
+		 * caller.
+		 */
+		(void)POPs;
+		cd->log(ISC_LOG_ERROR, "DLZ Perl: findzone died in eval: %s",
+			SvPV_nolen(ERRSV));
+		retval = ISC_R_FAILURE;
+	} else if (r == 0) {
+		retval = ISC_R_FAILURE;
+	} else if (r > 1) {
+		/* Once again, clean out the stack when possible. */
+		while (r--) {
+			POPi;
+		}
+		cd->log(ISC_LOG_ERROR, "DLZ Perl: findzone returned too many "
+				       "parameters!");
+		retval = ISC_R_FAILURE;
+	} else {
+		r = POPi;
+		if (r) {
+			retval = ISC_R_SUCCESS;
+		} else {
+			retval = ISC_R_NOTFOUND;
+		}
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+	return (retval);
+}
+
+#if DLZ_DLOPEN_VERSION == 1
+isc_result_t
+dlz_lookup(const char *zone, const char *name, void *dbdata,
+	   dns_sdlzlookup_t *lookup)
+#else  /* if DLZ_DLOPEN_VERSION == 1 */
+isc_result_t
+dlz_lookup(const char *zone, const char *name, void *dbdata,
+	   dns_sdlzlookup_t *lookup, dns_clientinfomethods_t *methods,
+	   dns_clientinfo_t *clientinfo)
+#endif /* if DLZ_DLOPEN_VERSION == 1 */
+{
+	isc_result_t retval;
+	config_data_t *cd = (config_data_t *)dbdata;
+	int rrcount, r;
+	dlz_perl_clientinfo_opaque opaque;
+	SV *record_ref;
+	SV **rr_type;
+	SV **rr_ttl;
+	SV **rr_data;
+#ifdef MULTIPLICITY
+	PerlInterpreter *my_perl = cd->perl;
+#endif /* ifdef MULTIPLICITY */
+
+#if DLZ_DLOPEN_VERSION >= 2
+	UNUSED(methods);
+	UNUSED(clientinfo);
+#endif /* if DLZ_DLOPEN_VERSION >= 2 */
+
+	dSP;
+	PERL_SET_CONTEXT(cd->perl);
+	ENTER;
+	SAVETMPS;
+
+	opaque.methods = methods;
+	opaque.clientinfo = clientinfo;
+
+	PUSHMARK(SP);
+	XPUSHs(cd->perl_class);
+	XPUSHs(sv_2mortal(newSVpv(name, 0)));
+	XPUSHs(sv_2mortal(newSVpv(zone, 0)));
+	XPUSHs(sv_2mortal(newSViv((IV)&opaque)));
+	PUTBACK;
+
+	carp("DLZ Perl: Searching for name %s in zone %s", name, zone);
+	rrcount = call_method("lookup", G_ARRAY | G_EVAL);
+	carp("DLZ Perl: Call to lookup returned %i", rrcount);
+
+	SPAGAIN;
+
+	if (SvTRUE(ERRSV)) {
+		(void)POPs;
+		cd->log(ISC_LOG_ERROR, "DLZ Perl: lookup died in eval: %s",
+			SvPV_nolen(ERRSV));
+		retval = ISC_R_FAILURE;
+		goto CLEAN_UP_AND_RETURN;
+	}
+
+	if (!rrcount) {
+		retval = ISC_R_NOTFOUND;
+		goto CLEAN_UP_AND_RETURN;
+	}
+
+	retval = ISC_R_SUCCESS;
+	r = 0;
+	while (r++ < rrcount) {
+		record_ref = POPs;
+		if ((!SvROK(record_ref)) ||
+		    (SvTYPE(SvRV(record_ref)) != SVt_PVAV))
+		{
+			cd->log(ISC_LOG_ERROR, "DLZ Perl: lookup returned an "
+					       "invalid value (expected array "
+					       "of arrayrefs)!");
+			retval = ISC_R_FAILURE;
+			break;
+		}
+
+		record_ref = SvRV(record_ref);
+
+		rr_type = av_fetch((AV *)record_ref, 0, 0);
+		rr_ttl = av_fetch((AV *)record_ref, 1, 0);
+		rr_data = av_fetch((AV *)record_ref, 2, 0);
+
+		if (rr_type == NULL || rr_ttl == NULL || rr_data == NULL) {
+			cd->log(ISC_LOG_ERROR,
+				"DLZ Perl: lookup for record %s in "
+				"zone %s returned an array that was "
+				"missing data",
+				name, zone);
+			retval = ISC_R_FAILURE;
+			break;
+		}
+
+		carp("DLZ Perl: Got record %s = %s", SvPV_nolen(*rr_type),
+		     SvPV_nolen(*rr_data));
+		retval = cd->putrr(lookup, SvPV_nolen(*rr_type), SvIV(*rr_ttl),
+				   SvPV_nolen(*rr_data));
+
+		if (retval != ISC_R_SUCCESS) {
+			cd->log(ISC_LOG_ERROR,
+				"DLZ Perl: putrr for lookup of %s in "
+				"zone %s failed with code %i "
+				"(did lookup return invalid record data?)",
+				name, zone, retval);
+			break;
+		}
+	}
+
+CLEAN_UP_AND_RETURN:
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	carp("DLZ Perl: Returning from lookup, r = %i, retval = %i", r, retval);
+
+	return (retval);
+}
+
+static const char *
+#ifdef MULTIPLICITY
+missing_perl_method(const char *perl_class_name, PerlInterpreter *my_perl)
+#else  /* ifdef MULTIPLICITY */
+missing_perl_method(const char *perl_class_name)
+#endif /* ifdef MULTIPLICITY */
+{
+	char full_name[BUF_LEN];
+	const char *methods[] = { "new", "findzone", "lookup", NULL };
+	int i = 0;
+
+	while (methods[i] != NULL) {
+		snprintf(full_name, BUF_LEN, "%s::%s", perl_class_name,
+			 methods[i]);
+
+		if (get_cv(full_name, 0) == NULL) {
+			return (methods[i]);
+		}
+		i++;
+	}
+
+	return (NULL);
+}
+
+isc_result_t
+dlz_create(const char *dlzname, unsigned int argc, char *argv[], void **dbdata,
+	   ...) {
+	config_data_t *cd;
+	char *perlrun[] = { (char *)"", NULL, (char *)"dlz perl", NULL };
+	char *perl_class_name;
+	int r;
+	va_list ap;
+	const char *helper_name;
+	const char *missing_method_name;
+	char *call_argv_args = NULL;
+#ifdef MULTIPLICITY
+	PerlInterpreter *my_perl;
+#endif /* ifdef MULTIPLICITY */
+
+	cd = malloc(sizeof(config_data_t));
+	if (cd == NULL) {
+		return (ISC_R_NOMEMORY);
+	}
+
+	memset(cd, 0, sizeof(config_data_t));
+
+	/* fill in the helper functions */
+	va_start(ap, dbdata);
+	while ((helper_name = va_arg(ap, const char *)) != NULL) {
+		b9_add_helper(cd, helper_name, va_arg(ap, void *));
+	}
+	va_end(ap);
+
+	if (argc < 2) {
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl '%s': Missing script argument.", dlzname);
+		free(cd);
+		return (ISC_R_FAILURE);
+	}
+
+	if (argc < 3) {
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl '%s': Missing class name argument.", dlzname);
+		free(cd);
+		return (ISC_R_FAILURE);
+	}
+	perl_class_name = argv[2];
+
+	cd->log(ISC_LOG_INFO, "DLZ Perl '%s': Loading '%s' from location '%s'",
+		dlzname, perl_class_name, argv[1], argc);
+
+#ifndef MULTIPLICITY
+	if (global_perl) {
+		/*
+		 * PERL_SET_CONTEXT not needed here as we're guaranteed to
+		 * have an implicit context thanks to an undefined
+		 * MULTIPLICITY.
+		 */
+		PL_perl_destruct_level = 1;
+		perl_destruct(global_perl);
+		perl_free(global_perl);
+		global_perl = NULL;
+		global_perl_dont_free = 1;
+	}
+#endif /* ifndef MULTIPLICITY */
+
+	cd->perl = perl_alloc();
+	if (cd->perl == NULL) {
+		free(cd);
+		return (ISC_R_FAILURE);
+	}
+#ifdef MULTIPLICITY
+	my_perl = cd->perl;
+#endif /* ifdef MULTIPLICITY */
+	PERL_SET_CONTEXT(cd->perl);
+
+	/*
+	 * We will re-create the interpreter during an rndc reconfig, so we
+	 * must set this variable per perlembed in order to insure we can
+	 * clean up Perl at a later time.
+	 */
+	PL_perl_destruct_level = 1;
+	perl_construct(cd->perl);
+	PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+	/* Prevent crashes from clients writing to $0 */
+	PL_origalen = 1;
+
+	cd->perl_source = strdup(argv[1]);
+	if (cd->perl_source == NULL) {
+		free(cd);
+		return (ISC_R_NOMEMORY);
+	}
+
+	perlrun[1] = cd->perl_source;
+	if (perl_parse(cd->perl, xs_init, 3, perlrun, (char **)NULL)) {
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl '%s': Failed to parse Perl script, aborting",
+			dlzname);
+		goto CLEAN_UP_PERL_AND_FAIL;
+	}
+
+	/* Let Perl know about our callbacks. */
+	call_argv("DLZ_Perl::clientinfo::bootstrap", G_DISCARD | G_NOARGS,
+		  &call_argv_args);
+	call_argv("DLZ_Perl::bootstrap", G_DISCARD | G_NOARGS, &call_argv_args);
+
+	/*
+	 * Run the script. We don't really need to do this since we have
+	 * the init callback, but there's not really a downside either.
+	 */
+	if (perl_run(cd->perl)) {
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl '%s': Script exited with an error, aborting",
+			dlzname);
+		goto CLEAN_UP_PERL_AND_FAIL;
+	}
+
+#ifdef MULTIPLICITY
+	if ((missing_method_name = missing_perl_method(perl_class_name,
+						       my_perl)))
+#else  /* ifdef MULTIPLICITY */
+	if ((missing_method_name = missing_perl_method(perl_class_name)))
+#endif /* ifdef MULTIPLICITY */
+	{
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl '%s': Missing required function '%s', "
+			"aborting",
+			dlzname, missing_method_name);
+		goto CLEAN_UP_PERL_AND_FAIL;
+	}
+
+	dSP;
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	XPUSHs(sv_2mortal(newSVpv(perl_class_name, 0)));
+
+	/* Build flattened hash of config info. */
+	XPUSHs(sv_2mortal(newSVpv("log_context", 0)));
+	XPUSHs(sv_2mortal(newSViv((IV)cd->log)));
+
+	/* Argument to pass to new? */
+	if (argc == 4) {
+		XPUSHs(sv_2mortal(newSVpv("argv", 0)));
+		XPUSHs(sv_2mortal(newSVpv(argv[3], 0)));
+	}
+
+	PUTBACK;
+
+	r = call_method("new", G_EVAL | G_SCALAR);
+
+	SPAGAIN;
+
+	if (r) {
+		cd->perl_class = SvREFCNT_inc(POPs);
+	}
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	if (SvTRUE(ERRSV)) {
+		(void)POPs;
+		cd->log(ISC_LOG_ERROR, "DLZ Perl '%s': new died in eval: %s",
+			dlzname, SvPV_nolen(ERRSV));
+		goto CLEAN_UP_PERL_AND_FAIL;
+	}
+
+	if (!r || !sv_isobject(cd->perl_class)) {
+		cd->log(ISC_LOG_ERROR,
+			"DLZ Perl '%s': new failed to return a blessed object",
+			dlzname);
+		goto CLEAN_UP_PERL_AND_FAIL;
+	}
+
+	*dbdata = cd;
+
+#ifndef MULTIPLICITY
+	global_perl = cd->perl;
+#endif /* ifndef MULTIPLICITY */
+	return (ISC_R_SUCCESS);
+
+CLEAN_UP_PERL_AND_FAIL:
+	PL_perl_destruct_level = 1;
+	perl_destruct(cd->perl);
+	perl_free(cd->perl);
+	free(cd->perl_source);
+	free(cd);
+	return (ISC_R_FAILURE);
+}
+
+void
+dlz_destroy(void *dbdata) {
+	config_data_t *cd = (config_data_t *)dbdata;
+#ifdef MULTIPLICITY
+	PerlInterpreter *my_perl = cd->perl;
+#endif /* ifdef MULTIPLICITY */
+
+	cd->log(ISC_LOG_INFO, "DLZ Perl: Unloading driver.");
+
+#ifndef MULTIPLICITY
+	if (!global_perl_dont_free) {
+#endif /* ifndef MULTIPLICITY */
+		PERL_SET_CONTEXT(cd->perl);
+		PL_perl_destruct_level = 1;
+		perl_destruct(cd->perl);
+		perl_free(cd->perl);
+#ifndef MULTIPLICITY
+		global_perl_dont_free = 0;
+		global_perl = NULL;
+	}
+#endif /* ifndef MULTIPLICITY */
+
+	free(cd->perl_source);
+	free(cd);
+}
diff --git a/contrib/dlz/modules/perl/dlz_perl_driver.h b/contrib/dlz/modules/perl/dlz_perl_driver.h
new file mode 100644
index 0000000..2cfb24d
--- /dev/null
+++ b/contrib/dlz/modules/perl/dlz_perl_driver.h
@@ -0,0 +1,37 @@
+/*
+ * Copyright (C) Internet Systems Consortium, Inc. ("ISC")
+ *
+ * SPDX-License-Identifier: MPL-2.0 and ISC
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, you can obtain one at https://mozilla.org/MPL/2.0/.
+ */
+
+/*
+ * Copyright (C) Stichting NLnet, Netherlands, stichting@nlnet.nl.
+ * Copyright (C) John Eaglesham
+ *
+ * The development of Dynamically Loadable Zones (DLZ) for Bind 9 was
+ * conceived and contributed by Rob Butler.
+ *
+ * Permission to use, copy, modify, and distribute this software for any purpose
+ * with or without fee is hereby granted, provided that the above copyright
+ * notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+ * REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+ * INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+ * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+ * OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+ * PERFORMANCE OF THIS SOFTWARE.
+ */
+
+#include <dlz_minimal.h>
+
+/* This is the only part that differs from dlz_minimal.h. */
+typedef struct dlz_perl_clientinfo_opaque {
+	dns_clientinfomethods_t *methods;
+	dns_clientinfo_t *clientinfo;
+} dlz_perl_clientinfo_opaque;
diff --git a/contrib/dlz/modules/perl/testing/dlz_perl_example.pm b/contrib/dlz/modules/perl/testing/dlz_perl_example.pm
new file mode 100644
index 0000000..eafa87c
--- /dev/null
+++ b/contrib/dlz/modules/perl/testing/dlz_perl_example.pm
@@ -0,0 +1,185 @@
+# Copyright Internet Systems Consortium, Inc. ("ISC")
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, you can obtain one at https://mozilla.org/MPL/2.0/.
+
+# Copyright (C) Stichting NLnet, Netherlands, stichting@nlnet.nl.
+# Copyright (C) John Eaglesham
+#
+# The development of Dynamically Loadable Zones (DLZ) for Bind 9 was
+# conceived and contributed by Rob Butler.
+#
+# SPDX-License-Identifier: ISC and MPL-2.0
+#
+# Permission to use, copy, modify, and distribute this software for any purpose
+# with or without fee is hereby granted, provided that the above copyright
+# notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND STICHTING NLNET DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL STICHTING NLNET BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
+# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+package dlz_perl_example;
+
+use warnings;
+use strict;
+
+use Data::Dumper;
+$Data::Dumper::Sortkeys = 1;
+
+# Constructor. Everything after the class name can be folded into a hash of
+# various options and settings. Right now only log_context and argv are
+# available.
+sub new {
+    my ( $class, %config ) = @_;
+    my $self = {};
+    bless $self, $class;
+
+    $self->{log} = sub {
+        my ( $level, $msg ) = @_;
+        DLZ_Perl::log( $config{log_context}, $level, $msg );
+    };
+
+    if ( $config{argv} ) { warn "Got argv: $config{argv}\n"; }
+
+    $self->{zones} = {
+        'example.com' => {
+            '@' => [
+                {
+                    type => 'SOA',
+                    ttl  => 86400,
+                    data =>
+                     'ns1.example.com. hostmaster.example.com. 12345 172800 900 1209600 3600',
+                }
+            ],
+            perlrr => [
+                {
+                    type => 'A',
+                    ttl  => 444,
+                    data => '1.1.1.1',
+                },
+                {
+                    type => 'A',
+                    ttl  => 444,
+                    data => '1.1.1.2',
+                }
+            ],
+            perltime => [
+                {
+                    code => sub {
+                        return ['TXT', '1', time()];
+                    },
+                },
+            ],
+            sourceip => [
+                {
+                    code => sub {
+                        my ( $opaque ) = @_;
+                        # Passing anything other than the proper opaque value,
+                        # 0, or undef to this function will cause a crash (at
+                        # best!).
+                        my ( $addr, $port ) =
+                         DLZ_Perl::clientinfo::sourceip( $opaque );
+                        if ( !$addr ) { $addr = $port = 'unknown'; }
+                        return ['TXT', '1', $addr], ['TXT', '1', $port];
+                    },
+                },
+            ],
+        },
+    };
+
+    $self->{log}->(
+        DLZ_Perl::LOG_INFO(),
+        'DLZ Perl Script: Called init. Loaded zone data: '
+         . Dumper( $self->{zones} )
+    );
+    return $self;
+}
+
+# Do we have data for this zone? Expects a simple true or false return value.
+sub findzone {
+    my ( $self, $zone ) = @_;
+    $self->{log}->(
+        DLZ_Perl::LOG_INFO(),
+        "DLZ Perl Script: Called findzone, looking for zone $zone"
+    );
+
+    return exists $self->{zones}->{$zone};
+}
+
+# Return the data for a given record in a given zone. The final parameter is
+# an opaque value that can be passed to DLZ_Perl::clientinfo::sourceip to
+# retrieve the client source IP and port. Expected return value is an array
+# of array refs, with each array ref representing one record and containing
+# the type, ttl, and data in that order. Data is as it appears in a zone file.
+sub lookup {
+    my ( $self, $name, $zone, $client_info ) = @_;
+    $self->{log}->(
+        DLZ_Perl::LOG_INFO(),
+        "DLZ Perl Script: Called lookup, looking for record $name in zone $zone"
+    );
+    return unless $self->{zones}->{$zone}->{$name};
+
+    my @results;
+    foreach my $rr ( @{ $self->{zones}->{$zone}->{$name} } ) {
+        if ( $rr->{'code'} ) {
+            my @r = $rr->{'code'}->( $client_info );
+            if ( @r ) {
+                push @results, @r;
+            }
+        } else {
+            push @results, [$rr->{'type'}, $rr->{'ttl'}, $rr->{'data'}];
+        }
+    }
+
+    return @results;
+}
+
+# Will we allow zone transfer for this client? Expects a simple true or false
+# return value.
+sub allowzonexfr {
+    my ( $self, $zone, $client ) = @_;
+    $self->{log}->(
+        DLZ_Perl::LOG_INFO(),
+        "DLZ Perl Script: Called allowzonexfr, looking for zone $zone for " .
+        "client $client"
+    );
+    if ( $client eq '127.0.0.1' ) { return 1; }
+    return 0;
+}
+
+# Note the return AoA for this method differs from lookup in that it must
+# return the name of the record as well as the other data.
+sub allnodes {
+    my ( $self, $zone ) = @_;
+    my @results;
+    $self->{log}->(
+        DLZ_Perl::LOG_INFO(),
+        "DLZ Perl Script: Called allnodes, looking for zone $zone"
+    );
+
+    foreach my $name ( keys %{ $self->{zones}->{$zone} } ) {
+        foreach my $rr ( @{ $self->{zones}->{$zone}->{$name} } ) {
+            if ( $rr->{'code'} ) {
+                my @r = $rr->{'code'}->();
+                # The code returns an array of array refs without the name.
+                # This makes things easy for lookup but hard here. We must
+                # iterate over each array ref and inject the name into it.
+                foreach my $a ( @r ) {
+                    unshift @{$a}, $name;
+                }
+                push @results, @r;
+            } else {
+                push @results,
+                 [$name, $rr->{'type'}, $rr->{'ttl'}, $rr->{'data'}];
+            }
+        }
+    }
+    return @results;
+}
+
+1;
diff --git a/contrib/dlz/modules/perl/testing/named.conf b/contrib/dlz/modules/perl/testing/named.conf
new file mode 100644
index 0000000..293d655
--- /dev/null
+++ b/contrib/dlz/modules/perl/testing/named.conf
@@ -0,0 +1,26 @@
+/*
+ * Copyright (C) Internet Systems Consortium, Inc. ("ISC")
+ *
+ * SPDX-License-Identifier: MPL-2.0
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0.  If a copy of the MPL was not distributed with this
+ * file, you can obtain one at https://mozilla.org/MPL/2.0/.
+ *
+ * See the COPYRIGHT file distributed with this work for additional
+ * information regarding copyright ownership.
+ */
+
+options {
+	port 5300;
+	pid-file "named.pid";
+	session-keyfile "session.key";
+	listen-on { 127.0.0.1; };
+	listen-on-v6 { none; };
+	recursion no;
+	notify no;
+};
+
+dlz "perl zone" {
+	database "dlopen ../dlz_perl_driver.so dlz_perl_example.pm dlz_perl_example";
+};