Commit 3b9ba6bd authored by Evan Hunt's avatar Evan Hunt
Browse files

[master] added DLZ Perl module

3602.	[contrib]	Added DLZ Perl module, allowing Perl scripts to
			integrate with named and serve DNS data.
			(Contributed by John Eaglesham of Yahoo.)
parent 1761ecb9
3602. [contrib] Added DLZ Perl module, allowing Perl scripts to
integrate with named and serve DNS data.
(Contributed by John Eaglesham of Yahoo.)
3601. [bug] Added to PKCS#11 openssl patches a value len
attribute in DH derive key. [RT #33928]
......
BIND 9 DLZ Perl module (bind-dlz-tools)
Written by John Eaglesham <johneagl@yahoo-inc.com>
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/
/*
* Copyright (C) 2012 John Eaglesham
*
* 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 JOHN EAGLESHAM
* DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
* JOHN EAGLESHAM 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 );
/*
* Copyright (C) 2012 John Eaglesham
*
* 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 JOHN EAGLESHAM
* DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
* JOHN EAGLESHAM 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)));
/*
* Copyright (C) 2002 Stichting NLnet, Netherlands, stichting@nlnet.nl.
*
* 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.
*
* 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 ROB BUTLER
* DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
* ROB BUTLER 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.
*/
/*
* Copyright (C) 1999-2001 Internet Software Consortium.
*
* 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 INTERNET SOFTWARE CONSORTIUM
* DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
* INTERNET SOFTWARE CONSORTIUM 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.
*/
/*
* Copyright (C) 2009-2012 John Eaglesham
*
* 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 JOHN EAGLESHAM
* DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
* JOHN EAGLESHAM 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 <config.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <EXTERN.h>
#include <perl.h>
#include <dlz_minimal.h>
#include "dlz_perl_driver.h"
/* Enable debug logging? */
#if 0
#define carp(...) cd->log(ISC_LOG_INFO, __VA_ARGS__);
#else
#define carp(...)
#endif
#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
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)
{
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) {
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
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)) {
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
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.
*/
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
isc_result_t
dlz_findzonedb(void *dbdata, const char *name,
dns_clientinfomethods_t *methods,
dns_clientinfo_t *clientinfo)
#endif
{
config_data_t *cd = (config_data_t *) dbdata;
int r;
isc_result_t retval;
#ifdef MULTIPLICITY
PerlInterpreter *my_perl = cd->perl;
#endif
#if DLZ_DLOPEN_VERSION >= 3
UNUSED(methods);
UNUSED(clientinfo);
#endif
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.
*/
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
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
{
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
#if DLZ_DLOPEN_VERSION >= 2
UNUSED(methods);
UNUSED(clientinfo);
#endif
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;