/* * adns.xs * - the C and XS part of the interface between adns and perl * * $Id: adns.xs,v 1.21 1999/11/30 10:45:42 fanf Exp $ */ /* * This file is * Copyright (C) 1999 Tony Finch * * It is part of adns, which is * Copyright (C) 1997-1999 Ian Jackson * Copyright (C) 1999 Tony Finch * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2, or (at your option) * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software Foundation, * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #include "adns.h" #ifdef USE_PERLIO #error perl must be compiled without PerlIO #endif #ifdef DEBUGGING #define DEBUGMSG(args) warn args #else #define DEBUGMSG(args) #endif /* * A Net::adns::quey does not directly refer to an adns_query; instead * it is a pair of the parent Net::adns::state and an internal query * object which is primarily owned by the Net::adns::state. This * ensures that the adns_state stays around as long as there are * external references to queries. When a query completes, the * internal query structure is turned into a Net::adns::answer so that * the external query can continue to behave like an incomplete query. */ typedef struct { SV *state; SV *quans; /* a Net::adns::query::internal or a Net::adns::answer */ } adns_extqu; /* * The internal query object contains the real adns_query and a * reference to the user-supplied context. The real adns_query's * context pointer points to the SV that contains this record * (i.e. it isn't the same as the user-supplied context). */ typedef struct { adns_query query; SV *plctx; } adns_intqu; /* * define the C versions of our Perl data types */ typedef adns_state Net__adns; typedef adns_extqu * Net__adns__query; typedef adns_intqu * Net__adns__query__internal; typedef adns_answer * Net__adns__answer; /* * get the C pointer out of an SV */ #define Sv2ptr(sv) ((void*)SvIV((SV*)SvRV(sv))) /* * deal with piles of enum constants */ #define adns_if_str "adns_if_" #define adns_qf_str "adns_qf_" #define adns_r_str "adns_r_" #define adns_s_str "adns_s_" static int constant(char *name, int arg) { errno= 0; if(!strncmp(name, adns_if_str, sizeof(adns_if_str)-1)) { if(!strcmp(name+8, "noenv")) return adns_if_noenv; if(!strcmp(name+8, "noerrprint")) return adns_if_noerrprint; if(!strcmp(name+8, "noserverwarn")) return adns_if_noserverwarn; if(!strcmp(name+8, "debug")) return adns_if_debug; if(!strcmp(name+8, "logpid")) return adns_if_logpid; if(!strcmp(name+8, "noautosys")) return adns_if_noautosys; if(!strcmp(name+8, "eintr")) return adns_if_eintr; if(!strcmp(name+8, "nosigpipe")) return adns_if_nosigpipe; if(!strcmp(name+8, "checkc_entex")) return adns_if_checkc_entex; if(!strcmp(name+8, "checkc_freq")) return adns_if_checkc_freq; } if(!strncmp(name, adns_qf_str, sizeof(adns_qf_str)-1)) { if(!strcmp(name+8, "search")) return adns_qf_search; if(!strcmp(name+8, "usevc")) return adns_qf_usevc; if(!strcmp(name+8, "owner")) return adns_qf_owner; if(!strcmp(name+8, "quoteok_query")) return adns_qf_quoteok_query; if(!strcmp(name+8, "quoteok_cname")) return adns_qf_quoteok_cname; if(!strcmp(name+8, "quoteok_anshost")) return adns_qf_quoteok_anshost; if(!strcmp(name+8, "quotefail_cname")) return adns_qf_quotefail_cname; if(!strcmp(name+8, "cname_loose")) return adns_qf_cname_loose; if(!strcmp(name+8, "cname_forbid")) return adns_qf_cname_forbid; } if(!strncmp(name, adns_r_str, sizeof(adns_r_str)-1)) { if(!strcmp(name+7, "none")) return adns_r_none; if(!strcmp(name+7, "a")) return adns_r_a; if(!strcmp(name+7, "ns_raw")) return adns_r_ns_raw; if(!strcmp(name+7, "ns")) return adns_r_ns; if(!strcmp(name+7, "cname")) return adns_r_cname; if(!strcmp(name+7, "soa_raw")) return adns_r_soa_raw; if(!strcmp(name+7, "soa")) return adns_r_soa; if(!strcmp(name+7, "ptr_raw")) return adns_r_ptr_raw; if(!strcmp(name+7, "ptr")) return adns_r_ptr; if(!strcmp(name+7, "hinfo")) return adns_r_hinfo; if(!strcmp(name+7, "mx_raw")) return adns_r_mx_raw; if(!strcmp(name+7, "mx")) return adns_r_mx; if(!strcmp(name+7, "txt")) return adns_r_txt; if(!strcmp(name+7, "rp_raw")) return adns_r_rp_raw; if(!strcmp(name+7, "rp")) return adns_r_rp; /* if(!strcmp(name+7, "addr")) return adns_r_addr; */ } if(!strncmp(name, adns_s_str, sizeof(adns_s_str)-1)) { if(!strcmp(name+7, "ok")) return adns_s_ok; if(!strcmp(name+7, "nomemory")) return adns_s_nomemory; if(!strcmp(name+7, "unknownrrtype")) return adns_s_unknownrrtype; if(!strcmp(name+7, "systemfail")) return adns_s_systemfail; if(!strcmp(name+7, "timeout")) return adns_s_timeout; if(!strcmp(name+7, "allservfail")) return adns_s_allservfail; if(!strcmp(name+7, "norecurse")) return adns_s_norecurse; if(!strcmp(name+7, "invalidresponse")) return adns_s_invalidresponse; if(!strcmp(name+7, "unknownformat")) return adns_s_unknownformat; if(!strcmp(name+7, "rcodeservfail")) return adns_s_rcodeservfail; if(!strcmp(name+7, "rcodeformaterror")) return adns_s_rcodeformaterror; if(!strcmp(name+7, "rcodenotimplemented")) return adns_s_rcodenotimplemented; if(!strcmp(name+7, "rcoderefused")) return adns_s_rcoderefused; if(!strcmp(name+7, "rcodeunknown")) return adns_s_rcodeunknown; if(!strcmp(name+7, "inconsistent")) return adns_s_inconsistent; if(!strcmp(name+7, "prohibitedcname")) return adns_s_prohibitedcname; if(!strcmp(name+7, "answerdomaininvalid")) return adns_s_answerdomaininvalid; if(!strcmp(name+7, "answerdomaintoolong")) return adns_s_answerdomaintoolong; if(!strcmp(name+7, "invaliddata")) return adns_s_invaliddata; if(!strcmp(name+7, "querydomainwrong")) return adns_s_querydomainwrong; if(!strcmp(name+7, "querydomaininvalid")) return adns_s_querydomaininvalid; if(!strcmp(name+7, "querydomaintoolong")) return adns_s_querydomaintoolong; if(!strcmp(name+7, "nxdomain")) return adns_s_nxdomain; if(!strcmp(name+7, "nodata")) return adns_s_nodata; } errno= EINVAL; return 0; } /* * work out what type of answer we have */ static SV * blessed_answer(SV *sv, adns_answer *answer) { char *blessing; if(!sv) sv= sv_newmortal(); if(errno || !answer) return sv; switch(answer->type) { case adns_r_a: blessing= "Net::adns::answer::a"; break; case adns_r_addr: blessing= "Net::adns::answer::addr"; break; case adns_r_mx: blessing= "Net::adns::answer::mx"; break; case adns_r_mx_raw: blessing= "Net::adns::answer::mx_raw"; break; case adns_r_ns: blessing= "Net::adns::answer::ns"; break; case adns_r_ns_raw: blessing= "Net::adns::answer::ns_raw"; break; case adns_r_rp: blessing= "Net::adns::answer::rp"; break; case adns_r_rp_raw: blessing= "Net::adns::answer::rp"; break; case adns_r_ptr: blessing= "Net::adns::answer::ptr"; break; case adns_r_ptr_raw:blessing= "Net::adns::answer::ptr_raw"; break; case adns_r_soa: blessing= "Net::adns::answer::soa"; break; case adns_r_soa_raw:blessing= "Net::adns::answer::soa"; break; case adns_r_txt: blessing= "Net::adns::answer::txt"; break; case adns_r_cname: blessing= "Net::adns::answer::cname"; break; case adns_r_hinfo: blessing= "Net::adns::answer::hinfo"; break; default: blessing= "Net::adns::answer"; break; } sv_setref_pv(sv, blessing, (void*)answer); DEBUGMSG(("new %p %s\n", SvRV(sv), blessing)); return sv; } /* * adns_check and adns_wait both have this type */ typedef int check_or_wait_fn(adns_state ads, adns_query *query_io, adns_answer **answer_r, void **context_r); /* * Generic code to check or wait for queries. When turning the * internal query object into an answer object we make it mortal * because we have lost the reference to it from the adns_state * object. */ static SV * do_check_or_wait(check_or_wait_fn *check_or_wait, adns_state adns, adns_query query) { adns_answer *answer= 0; void *plintqu= 0; /* really an SV* */ errno= check_or_wait(adns, &query, &answer, &plintqu); return blessed_answer(sv_2mortal(plintqu), answer); } /* * Generic code to check or wait for a given perl query object */ static SV * do_query_check_or_wait(check_or_wait_fn *check_or_wait, adns_extqu *extqu) { if(sv_isa(extqu->quans, "Net::adns::query::internal")) { adns_intqu *intqu= Sv2ptr(extqu->quans); adns_state adns= Sv2ptr(extqu->state); return do_check_or_wait(check_or_wait, adns, intqu->query); } else if(sv_isa(extqu->quans, "Net::adns::answer")) { return sv_2mortal(SvREFCNT_inc(extqu->quans)); } else { croak("corrupt Net::adns::query object"); } } /* * end of C preamble */ MODULE = Net::adns PACKAGE = Net::adns PROTOTYPES: enable # # now we are in the world of XS # # # enum constants # int constant(name,arg) char * name int arg # # main adns state object creation and destruction # the init function is called by Net::adns::new # SV * init(initflags=0, diagfile=0, configtext=0) int initflags FILE * diagfile char * configtext CODE: { adns_state adns= 0; if(configtext) errno= adns_init_strcfg(&adns, initflags, diagfile, configtext); else errno= adns_init(&adns, initflags, diagfile); /* default return value is undef */ ST(0)= sv_newmortal(); if(!errno && adns) sv_setref_pv(ST(0), "Net::adns", (void*)adns); DEBUGMSG(("new %p Net::adns\n", SvRV(ST(0)))); } void DESTROY(adns) Net::adns adns CODE: { void *plintqu; /* really an SV* */ /* release all of our plintqus */ for(adns_forallqueries_begin(adns); adns_forallqueries_next(adns, &plintqu); SvREFCNT_dec(plintqu)); DEBUGMSG(("del %p Net::adns\n", SvRV(ST(0)))); adns_finish(adns); } # # start a query # SV * submit(adns, owner, type, flags=0, plctx=0) Net::adns adns char * owner int type int flags SV * plctx CODE: { adns_query query; SV *plintqu= sv_newmortal(); SV *plextqu= sv_newmortal(); errno= adns_submit(adns, owner, type, flags, plintqu, &query); if(!errno && query) { adns_intqu *intqu= safemalloc(sizeof(*intqu)); adns_extqu *extqu= safemalloc(sizeof(*extqu)); SvREFCNT_inc(plintqu); /* count adns's reference */ intqu->query= query; intqu->plctx= SvREFCNT_inc(plctx); sv_setref_pv(plintqu, "Net::adns::query::internal", (void*)intqu); DEBUGMSG(("new %p Net::adns::query::internal\n", SvRV(plintqu))); extqu->state= SvREFCNT_inc(ST(0)); /* ST(0) is our first arg */ extqu->quans= SvREFCNT_inc(plintqu); sv_setref_pv(plextqu, "Net::adns::query", (void*)extqu); DEBUGMSG(("new %p Net::adns::query\n", SvRV(plextqu))); } ST(0)= plextqu; /* ST(0) is our return value */ } # # get an answer from a query if one is ready # SV * check(adns) Net::adns adns CODE: ST(0)= do_check_or_wait(adns_check, adns, 0); # # wait for a completed query and return its answer # SV * wait(adns) Net::adns adns CODE: ST(0)= do_check_or_wait(adns_wait, adns, 0); # # start a query and wait for the answer in one go # SV * synchronous(adns, owner, type, flags=0) Net::adns adns char * owner int type int flags CODE: { adns_answer *answer= 0; errno= adns_synchronous(adns, owner, type, flags, &answer); ST(0)= blessed_answer(0, answer); } MODULE = Net::adns PACKAGE = Net::adns::query::internal void DESTROY(intqu) Net::adns::query::internal intqu CODE: SvREFCNT_dec(intqu->plctx); /* * We don't need to free the query explicitly because either (1) the * query has completed and has already been freed, or (2) the parent * adns_state object is about to be freed and it'll do the job. */ DEBUGMSG(("del %p Net::adns::query::internal\n", SvRV(ST(0)))); free(intqu); MODULE = Net::adns PACKAGE = Net::adns::query void DESTROY(extqu) Net::adns::query extqu CODE: SvREFCNT_dec(extqu->state); SvREFCNT_dec(extqu->quans); DEBUGMSG(("del %p Net::adns::query\n", SvRV(ST(0)))); free(extqu); # # get an answer from this query if one is ready # SV * check(extqu) Net::adns::query extqu CODE: ST(0)= do_query_check_or_wait(adns_check, extqu); # # wait for this query to complete and return its answer # SV * wait(extqu) Net::adns::query extqu CODE: ST(0)= do_query_check_or_wait(adns_wait, extqu); MODULE = Net::adns PACKAGE = Net::adns::answer void DESTROY(answer) Net::adns::answer answer CODE: DEBUGMSG(("del %p Net::adns::answer\n", SvRV(ST(0)))); free(answer); # # functions for getting information from an adns answer # int status(answer) Net::adns::answer answer CODE: RETVAL= answer->status; OUTPUT: RETVAL SV * cname(answer) Net::adns::answer answer CODE: { ST(0)= sv_newmortal(); if(answer->cname) sv_setpv(ST(0), answer->cname); } SV * owner(answer) Net::adns::answer answer CODE: { ST(0)= sv_newmortal(); if(answer->owner) sv_setpv(ST(0), answer->owner); } int expires(answer) Net::adns::answer answer CODE: RETVAL= answer->expires; OUTPUT: RETVAL int nrrs(answer) Net::adns::answer answer CODE: RETVAL= answer->nrrs; OUTPUT: RETVAL # # this function returns an interestingly complicated value # SV * type(answer) Net::adns::answer answer PPCODE: { const char *typename, *fmtname; if(adns_rr_info(answer->type, &typename, &fmtname, 0,0,0)) croak("adns couln't format the reply"); if(GIMME == G_ARRAY) { EXTEND(sp, 3); ST(0)= sv_2mortal(newSViv(answer->type)); ST(1)= sv_2mortal(newSVpv(typename, 0)); ST(2)= sv_2mortal(newSVpv(fmtname ? fmtname : "", 0)); XSRETURN(3); } else { ST(0)= sv_newmortal(); sv_setiv(ST(0), answer->type); sv_setpv(ST(0), typename); SvIOK_on(ST(0)); /* what a wonderful hack! */ XSRETURN(1); } } # # many accessor functions for answer types follow this formula # XXX: is there a better way of doing this? # #define ACCESSOR(set_str_and_len) \ { \ char *str; int len; \ if(items < 2 && GIMME == G_ARRAY) { \ EXTEND(sp, answer->nrrs); \ for(index=0; indexnrrs; index++) { \ len=0; do set_str_and_len while(0); \ ST(index)= sv_2mortal(newSVpv(str, len)); \ } \ XSRETURN(answer->nrrs); \ } else { \ ST(0)= sv_newmortal(); \ if(index >= 0 && index < answer->nrrs) { \ len=0; do set_str_and_len while(0); \ ST(index)= sv_2mortal(newSVpv(str, len)); \ } \ XSRETURN(1); \ } \ } # # generic answer -> text formatter # SV * txt(answer, index=0) Net::adns::answer answer int index PPCODE: ACCESSOR({ if(adns_rr_info(answer->type, 0,0,0, answer->rrs.bytes + answer->rrsz * index, &str)) croak("adns couln't format the reply"); }) MODULE = Net::adns PACKAGE = Net::adns::answer::a SV * addr(answer, index=0) Net::adns::answer answer int index PPCODE: ACCESSOR({ str=(void*)&answer->rrs.inaddr[index]; len=sizeof(answer->rrs.inaddr[index]); }) MODULE = Net::adns PACKAGE = Net::adns::answer::txt SV * strings(answer, index=0) Net::adns::answer answer int index PPCODE: if(index >= 0 && index < answer->nrrs) { adns_rr_intstr *istr; int count= 0; for(istr=answer->rrs.manyistr[index]; istr->str; istr++) count++; istr=answer->rrs.manyistr[index]; for(index=0; index