diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-05 18:37:14 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-05 18:37:14 +0000 |
commit | ea648e70a989cca190cd7403fe892fd2dcc290b4 (patch) | |
tree | e2b6b1c647da68b0d4d66082835e256eb30970e8 /contrib/dlz/modules/perl/dlz_perl_callback_clientinfo.xs | |
parent | Initial commit. (diff) | |
download | bind9-ea648e70a989cca190cd7403fe892fd2dcc290b4.tar.xz bind9-ea648e70a989cca190cd7403fe892fd2dcc290b4.zip |
Adding upstream version 1:9.11.5.P4+dfsg.upstream/1%9.11.5.P4+dfsgupstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'contrib/dlz/modules/perl/dlz_perl_callback_clientinfo.xs')
-rw-r--r-- | contrib/dlz/modules/perl/dlz_perl_callback_clientinfo.xs | 81 |
1 files changed, 81 insertions, 0 deletions
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..fd341d9 --- /dev/null +++ b/contrib/dlz/modules/perl/dlz_perl_callback_clientinfo.xs @@ -0,0 +1,81 @@ +/* + * 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))); + |