adns/adns.c

   1 /*
   2  * adns lookup TYPE DOMAIN [QUERY-OPTIONS]                    => [list RDATA]
   3  *    if no or dontknow, throws an exception, with errorCode one of
   4  *         ADNS permfail 300 nxdomain {No such domain}
   5  *         ADNS permfail 301 nodata {No such data}
   6  *         ADNS tempfail ERROR-CODE ERROR-NAME ERROR-STRING
   7  *    where
   8  *         ERROR-CODE is the numerical adns status value
   9  *         ERROR-NAME is the symbolic adns status value (in lowercase)
  10  *         ERROR-STRING is the result of adns_strstatus
  11  *
  12  * adns synch TYPE DOMAIN [QUERY-OPTIONS]                     => RESULTS
  13  *        RESULTS is [list ok|permfail|tempfail
  14  *                         ERROR-CODE ERROR-NAME ERROR-STRING  \
  15  *                         OWNER CNAME                         \
  16  *                         [list RDATA ...]]
  17  *        OWNER is the RR owner
  18  *        CNAME is the empty string or the canonical name if we went
  19  *                  via a CNAME
  20  *
  21  * adns asynch ON-YES ON-NO ON-DONTKNOW XARGS \
  22  *             TYPE DOMAIN \
  23  *             [QUERY-OPTIONS...]                            => QUERY-ID
  24  *        calls, later,
  25  *           [concat ON-YES|ON-NO|ON-DONTKNOW XARGS RESULTS]
  26  * adns asynch-cancel QUERY-ID
  27  *
  28  * QUERY-OPTIONS are zero or more of
  29  *         -resolver RESOLVER  (see adns new-resolver)
  30  *                 default is to use a default resolver
  31  *         -search
  32  *         -usevc
  33  *         -quoteok-query
  34  *         -quoteok-anshost
  35  *         -quotefail-cname
  36  *         -cname-loose
  37  *         -cname-forbid
  38  *         -reverse
  39  *         -reverse-any ZONE-A-LIKE
  40  *
  41  * adns new-resolver [RES-OPTIONS...]                         => RESOLVER
  42  *        options:
  43  *         -errfile stdout|stderr       (stderr is the default)
  44  *         -noerrprint
  45  *         -errcallback CALLBACK    results in  eval CALLBACK [list MESSAGE]
  46  *         -noenv|-debug|-logpid
  47  *         -checkc-entex
  48  *         -checkc-freq
  49  *         -config CONFIG-STRING
  50  *
  51  * adns set-default-resolver RESOLVER
  52  *        cancels any outstanding queries from a previous anonymous
  53  *        default resolver
  54  *
  55  * adns destroy-resolver RESOLVER
  56  *        cancels outstanding queries
  57  *
  58  */
  59 /* ---8<--- end of documentation comment --8<-- */
  60
  61 /*
  62  * adns.c - adns binding for Tcl
  63  * Copyright 2006 Ian Jackson
  64  *
  65  * This program is free software; you can redistribute it and/or
  66  * modify it under the terms of the GNU General Public License as
  67  * published by the Free Software Foundation; either version 2 of the
  68  * License, or (at your option) any later version.
  69  *
  70  * This program is distributed in the hope that it will be useful, but
  71  * WITHOUT ANY WARRANTY; without even the implied warranty of
  72  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  73  * General Public License for more details.
  74  *
  75  * You should have received a copy of the GNU General Public License
  76  * along with this library; if not, write to the Free Software
  77  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
  78  * 02110-1301, USA.
  79  */
  80
  81 #define _GNU_SOURCE
  82
  83 #include <stdio.h>
  84
  85 #include <adns.h>
  86
  87 #include "chiark_tcl_adns.h"
  88
  89 /*---------- important types and forward declarations ----------*/
  90
  91 typedef struct Query Query;
  92 typedef struct Resolver Resolver;
  93 typedef struct OptionInfo OptionInfo;
  94
  95 static void asynch_sethandlers(Resolver *res);
  96 static void asynch_cancelhandlers(Resolver *res);
  97 static void asynch_perturbed(Resolver *res);
  98
  99 static void asynch_query_dispose(Tcl_Interp *interp, Query *query);
 100
 101 #define ASSOC_DEFAULTRES "adns-defaultresolver"
 102
 103 /*---------- common resolver/query option processing ----------*/
 104
 105 typedef struct {
 106   /* this struct type is used to hold both resolver and query options */
 107   /* common to resolver and query: */
 108   unsigned long aflags;
 109   unsigned long sflags;
 110   /* resolver: */
 111   FILE *errfile;
 112   Tcl_Obj *errcallback;
 113   const char *config_string;
 114   /* query: */
 115   Resolver *resolver;
 116   const char *reverseany;
 117 } OptionParse;
 118
 119 struct OptionInfo {
 120   const char *name;
 121   int (*fn)(Tcl_Interp *ip, const OptionInfo *oi, Tcl_Obj *arg,
 122             OptionParse *op);
 123   int takesarg;
 124   unsigned long flags_add, flags_remove;
 125 };
 126
 127 enum {
 128   oisf_reverse=     0x0002
 129 };
 130
 131 static int oiufn_f(const OptionInfo *oi, unsigned long *flags) {
 132   *flags &= ~oi->flags_remove;
 133   *flags |= oi->flags_add;
 134   return TCL_OK;
 135 }
 136 static int oifn_fa(Tcl_Interp *ip, const OptionInfo *oi, Tcl_Obj *arg,
 137                    OptionParse *op) { return oiufn_f(oi,&op->aflags); }
 138 static int oifn_fs(Tcl_Interp *ip, const OptionInfo *oi, Tcl_Obj *arg,
 139                    OptionParse *op) { return oiufn_f(oi,&op->sflags); }
 140
 141 static int oifn_reverse_any(Tcl_Interp *ip, const OptionInfo *oi,
 142                             Tcl_Obj *arg, OptionParse *op) {
 143   return cht_pat_string(ip,arg,&op->reverseany);
 144 }
 145
 146 #define OIFA1(t,f,r) { "-" #f, oifn_fa, 0, adns_##t##_##f, r }
 147 #define OIFA2(t,f,g) { "-" #f "-" #g, oifn_fa, 0, adns_##t##_##f##_##g, 0 }
 148 #define OIFS(f) { "-" #f, oifn_fs, 0, oisf_##f, 0 }
 149 #define OICA(o) { "-" #o, oifn_##o, 1 }
 150
 151 static void optparse_blank(OptionParse *op) {
 152   memset(op,0,sizeof(*op));
 153   op->errfile= stderr;
 154   op->errcallback= 0;
 155   op->config_string= 0;
 156 }
 157
 158 static int parse_options(Tcl_Interp *ip, int objc, Tcl_Obj *const *objv,
 159                          const OptionInfo opttable[], OptionParse *op) {
 160   const OptionInfo *oi;
 161   const void *oi_v;
 162   Tcl_Obj *arg;
 163   int rc;
 164
 165   objc--; objv++;
 166   for (;;) {
 167     if (!objc--) break;
 168     rc= cht_pat_enum(ip, *objv++, &oi_v, opttable, sizeof(OptionInfo),
 169                  "query or resolver option");
 170     if (rc) return rc;
 171     oi= oi_v;
 172
 173     if (oi->takesarg) {
 174       if (!objc--) {
 175         cht_setstringresult(ip,"missing value for option");
 176         return TCL_ERROR;
 177       }
 178       arg= *objv++;
 179     } else {
 180       arg= 0;
 181     }
 182     rc= oi->fn(ip,oi,arg,op);
 183     if (rc) return rc;
 184   }
 185   return TCL_OK;
 186 }
 187
 188 /*---------- resolver management ----------*/
 189
 190 struct Resolver {
 191   int ix; /* first! */
 192   Tcl_Interp *interp;
 193   adns_state ads;
 194   Tcl_TimerToken timertoken;
 195   int maxfd;
 196   fd_set handling[3];
 197   ScriptToInvoke errcallback;
 198   Tcl_Obj *errstring_accum;
 199 };
 200
 201 /* The default resolver is recorded using Tcl_SetAssocData with key
 202  * ASSOC_DEFAULTRES to record the Resolver*.  If it was explicitly
 203  * created with `adns new-resolver' then ix will be >=0, and the
 204  * resolver will be destroyed - leaving no default - when explicitly
 205  * requested.  If it was implicitly created (by starting a query when
 206  * there is no default) then ix will be -1.  */
 207
 208 static int oifn_errfile(Tcl_Interp *ip, const OptionInfo *oi,
 209                         Tcl_Obj *arg, OptionParse *op) {
 210   int rc;
 211   const char *str;
 212
 213   rc= cht_pat_string(ip,arg,&str);  if (rc) return rc;
 214   if (!strcmp(str,"stderr")) op->errfile= stderr;
 215   else if (!strcmp(str,"stdout")) op->errfile= stdout;
 216   else return cht_staticerr(ip,"-errfile argument must be stderr or stdout",0);
 217
 218   op->aflags &= ~adns_if_noerrprint;
 219   op->errcallback= 0;
 220   return TCL_OK;
 221 }
 222
 223 static int oifn_errcallback(Tcl_Interp *ip, const OptionInfo *oi,
 224                             Tcl_Obj *arg, OptionParse *op) {
 225   op->errcallback= arg;
 226   op->aflags &= ~adns_if_noerrprint;
 227   op->errfile= 0;
 228   return TCL_OK;
 229 }
 230
 231 static int oifn_config(Tcl_Interp *ip, const OptionInfo *oi,
 232                        Tcl_Obj *arg, OptionParse *op) {
 233   return cht_pat_string(ip,arg,&op->config_string);
 234 }
 235
 236 static const OptionInfo resolver_optioninfos[]= {
 237   OIFA1(if,noenv, 0),
 238   OIFA1(if,debug, adns_if_noerrprint),
 239   OIFA1(if,logpid, adns_if_noerrprint),
 240   OIFA1(if,noerrprint, adns_if_debug),
 241   OIFA2(if,checkc,entex),
 242   OIFA2(if,checkc,freq),
 243   OICA(errfile),
 244   OICA(errcallback),
 245   OICA(config),
 246   { 0 }
 247 };
 248
 249 static void adnslogfn_flushmessage(Resolver *res) {
 250   cht_scriptinv_invoke(&res->errcallback, 1, &res->errstring_accum);
 251   Tcl_SetObjLength(res->errstring_accum, 0);
 252 }
 253
 254 static void adnslogfn_callback(adns_state ads, void *logfndata,
 255                                const char *fmt, va_list al) {
 256   Resolver *res= logfndata;
 257   int l, newline;
 258   char *str;
 259
 260   l= vasprintf(&str,fmt,al);
 261   if (l<0) {
 262     cht_posixerr(res->interp,errno,"construct adns log callback string");
 263     Tcl_BackgroundError(res->interp);
 264   }
 265
 266   if (l==0) { free(str); return; }
 267   if ((newline= l>0 && str[l-1]=='\n')) l--;
 268
 269   if (!res->errstring_accum) {
 270     res->errstring_accum= Tcl_NewStringObj(str,l);
 271     Tcl_IncrRefCount(res->errstring_accum);
 272   } else {
 273     Tcl_AppendToObj(res->errstring_accum,str,l);
 274   }
 275   free(str);
 276
 277   if (newline)
 278     adnslogfn_flushmessage(res);
 279 }
 280
 281 static Resolver *default_resolver(Tcl_Interp *ip) {
 282   return Tcl_GetAssocData(ip,ASSOC_DEFAULTRES,0);
 283 }
 284
 285 static void destroy_resolver(Tcl_Interp *ip, Resolver *res) {
 286   void *query_v;
 287   int logstring_len;
 288   char *rstr;
 289   adns_query aqu;
 290
 291   if (res == default_resolver(ip))
 292     Tcl_DeleteAssocData(ip,ASSOC_DEFAULTRES);
 293
 294   if (res->errstring_accum) {
 295     rstr= Tcl_GetStringFromObj(res->errstring_accum, &logstring_len);
 296     assert(rstr);
 297     if (logstring_len)
 298       adnslogfn_flushmessage(res);
 299   }
 300
 301   if (res->ads) {
 302     /* although adns would throw these away for us, we need to
 303      * destroy our own data too and only adns has a list of them */
 304     for (;;) {
 305       adns_forallqueries_begin(res->ads);
 306       aqu= adns_forallqueries_next(res->ads, &query_v);
 307       if (!aqu) break;
 308       asynch_query_dispose(ip, query_v);
 309     }
 310     adns_finish(res->ads);
 311     res->ads= 0;
 312   }
 313   asynch_cancelhandlers(res);
 314   cht_scriptinv_cancel(&res->errcallback);
 315   Tcl_EventuallyFree(res, Tcl_Free);
 316 }
 317
 318 static void destroy_resolver_idtabcb(Tcl_Interp *ip, void *resolver_v) {
 319   destroy_resolver(ip,resolver_v);
 320 }
 321 static void destroy_resolver_defcb(ClientData resolver_v, Tcl_Interp *ip) {
 322   destroy_resolver(ip,resolver_v);
 323 }
 324
 325 int cht_do_adns_destroy_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
 326   cht_tabledataid_disposing(ip,res_v,&cht_adnstcl_resolvers);
 327   destroy_resolver(ip,res_v);
 328   return TCL_OK;
 329 }
 330
 331 static int create_resolver(Tcl_Interp *ip, const OptionParse *op,
 332                            Resolver **res_r) {
 333   Resolver *res=0;
 334   int rc, i, ec;
 335
 336   res= TALLOC(sizeof(*res));  assert(res);
 337   res->ix= -1;
 338   res->interp= ip;
 339   res->ads= 0;
 340   res->timertoken= 0;
 341   res->maxfd= 0;
 342   for (i=0; i<3; i++) FD_ZERO(&res->handling[i]);
 343   cht_scriptinv_init(&res->errcallback);
 344   res->errstring_accum= 0;
 345
 346   if (op->errcallback)
 347     cht_scriptinv_set(&res->errcallback, ip, op->errcallback, 0);
 348
 349   ec= adns_init_logfn(&res->ads,
 350                       op->aflags | adns_if_noautosys,
 351                       op->config_string,
 352                       op->errcallback ? adnslogfn_callback : 0,
 353                       op->errcallback ? (void*)res : (void*)op->errfile);
 354   if (ec) { rc= cht_posixerr(ip,ec,"create adns resolver"); goto x_rc; }
 355
 356   *res_r= res;
 357   return TCL_OK;
 358
 359  x_rc:
 360   if (res) {
 361     if (res->ads) adns_finish(res->ads);
 362     TFREE(res);
 363   }
 364   return rc;
 365 }
 366
 367 int cht_do_adns_new_resolver(ClientData cd, Tcl_Interp *ip,
 368                          int objc, Tcl_Obj *const *objv,
 369                          void **result) {
 370   OptionParse op;
 371   Resolver *res=0;
 372   int rc;
 373
 374   optparse_blank(&op);
 375   rc= parse_options(ip,objc,objv,resolver_optioninfos,&op);
 376   if (rc) return rc;
 377
 378   if (op.aflags & adns_if_noerrprint) {
 379     op.errfile= 0;
 380     op.errcallback= 0;
 381   }
 382
 383   rc= create_resolver(ip, &op, &res);
 384   if (rc) return rc;
 385
 386   *result= res;
 387   return TCL_OK;
 388 }
 389
 390 int cht_do_adns_set_default_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
 391   Resolver *res= res_v;
 392   Tcl_DeleteAssocData(ip,ASSOC_DEFAULTRES);
 393   Tcl_SetAssocData(ip, ASSOC_DEFAULTRES, 0, res);
 394   return TCL_OK;
 395 }
 396
 397 const IdDataSpec cht_adnstcl_resolvers= {
 398   "adns-res", "adns-resolvers-table", destroy_resolver_idtabcb
 399 };
 400
 401 /*---------- query, query option and answers - common stuff ----------*/
 402
 403 #define RRTYPE_EXACTLY(t) { #t, adns_r_##t }
 404 #define RRTYPE_RAW(t) { #t, adns_r_##t##_raw }
 405 #define RRTYPE_PLUS(t) { #t "+", adns_r_##t }
 406 #define RRTYPE_MINUS(t) { #t "-", adns_r_##t##_raw }
 407
 408 const AdnsTclRRTypeInfo cht_adnstclrrtypeinfo_entries[]= {
 409   RRTYPE_EXACTLY(a),
 410   RRTYPE_EXACTLY(cname),
 411   RRTYPE_EXACTLY(hinfo),
 412   RRTYPE_EXACTLY(addr),
 413
 414   RRTYPE_RAW(ns),
 415   RRTYPE_RAW(mx),
 416
 417   RRTYPE_EXACTLY(soa),
 418   RRTYPE_EXACTLY(ptr),
 419   RRTYPE_EXACTLY(rp),
 420
 421   RRTYPE_MINUS(soa),
 422   RRTYPE_MINUS(ptr),
 423   RRTYPE_MINUS(rp),
 424   { 0 }
 425 };
 426
 427 static int oifn_resolver(Tcl_Interp *ip, const OptionInfo *oi,
 428                          Tcl_Obj *arg, OptionParse *op) {
 429   void *val_v;
 430   int rc;
 431
 432   rc= cht_pat_iddata(ip,arg,&val_v,&cht_adnstcl_resolvers);
 433   if (rc) return rc;
 434   op->resolver= val_v;
 435   return TCL_OK;
 436 }
 437
 438 static const OptionInfo query_optioninfos[]= {
 439   OIFA1(qf,search,0),
 440   OIFA1(qf,usevc,0),
 441   OIFA2(qf,quoteok,query),
 442   OIFA2(qf,quoteok,anshost),
 443   OIFA2(qf,quotefail,cname),
 444   OIFA2(qf,cname,loose),
 445   OIFA2(qf,cname,forbid),
 446   OICA(resolver),
 447   OIFS(reverse),
 448   { "-reverse-any", oifn_reverse_any, 1 },
 449   { 0 }
 450 };
 451
 452 static int query_submit(Tcl_Interp *ip,
 453                         const AdnsTclRRTypeInfo *type, const char *domain,
 454                         int queryopts_objc, Tcl_Obj *const *queryopts_objv,
 455                         adns_query *aqu_r, void *context, Resolver **res_r) {
 456   struct sockaddr sa;
 457   static const int aftry[]= { AF_INET, AF_INET6 };
 458   OptionParse op;
 459   OptionParse res_op;
 460   int rc, r, ec;
 461   adns_state ads;
 462
 463   op.aflags= adns_qf_owner;
 464   op.sflags= 0;
 465   op.resolver= 0;
 466   op.reverseany= 0;
 467   rc= parse_options(ip, queryopts_objc,queryopts_objv, query_optioninfos,&op);
 468   if (rc) return rc;
 469
 470   if (!op.resolver) {
 471     op.resolver= default_resolver(ip);
 472     if (!op.resolver) {
 473       optparse_blank(&res_op);
 474       rc= create_resolver(ip, &res_op, &op.resolver);
 475       if (rc) return rc;
 476
 477       Tcl_SetAssocData(ip, ASSOC_DEFAULTRES,
 478                        destroy_resolver_defcb, op.resolver);
 479     }
 480   }
 481
 482   *res_r= op.resolver;
 483
 484   if (op.reverseany || (op.sflags & oisf_reverse)) {
 485     const int *af;
 486     for (af=aftry; af < af + sizeof(af)/sizeof(*af); af++) {
 487       memset(&sa,0,sizeof(sa));
 488       sa.sa_family= *af;
 489       r= inet_pton(*af,domain,&sa);
 490       if (!r) goto af_found;
 491     }
 492     return cht_staticerr(ip,"invalid address for adns reverse submit",
 493                          "ADNS REVERSE INVALID");
 494   af_found:;
 495   }
 496
 497   ads= op.resolver->ads;
 498
 499   if (op.reverseany) {
 500     ec= adns_submit_reverse_any(ads, &sa, op.reverseany,
 501                                 type->number, op.aflags, context, aqu_r);
 502   } else if (op.sflags & oisf_reverse) {
 503     ec= adns_submit_reverse(ads, &sa,
 504                             type->number, op.aflags, context, aqu_r);
 505   } else {
 506     ec= adns_submit(ads, domain,
 507                     type->number, op.aflags, context, aqu_r);
 508   }
 509   if (ec)
 510     return cht_posixerr(ip,ec,"submit adns query");
 511
 512   return TCL_OK;
 513 }
 514
 515 #define RESULTSTATUS_LLEN 4
 516 #define RESULTLIST_LLEN 7
 517
 518 static void make_resultstatus(Tcl_Interp *ip, adns_status status,
 519                               Tcl_Obj *results[RESULTSTATUS_LLEN]) {
 520   results[0]= cht_ret_string(ip, adns_errtypeabbrev(status));
 521   results[1]= cht_ret_int(ip, status);
 522   results[2]= cht_ret_string(ip, adns_errabbrev(status));
 523   results[3]= cht_ret_string(ip, adns_strerror(status));
 524 }
 525
 526 static Tcl_Obj *make_resultrdata(Tcl_Interp *ip, adns_answer *answer) {
 527   Tcl_Obj **rdata, *rl;
 528   int i, rrsz;
 529   adns_status st;
 530   char *datap, *rdatastring;
 531
 532   rdata= TALLOC(sizeof(*rdata) * answer->nrrs);
 533   for (i=0, datap=answer->rrs.untyped;
 534        i<answer->nrrs;
 535        i++, datap += rrsz) {
 536     st= adns_rr_info(answer->type, 0,0, &rrsz, datap, &rdatastring);
 537     assert(!st);
 538     rdata[i]= cht_ret_string(ip, rdatastring);
 539     free(rdatastring);
 540   }
 541   rl= Tcl_NewListObj(answer->nrrs, rdata);
 542   TFREE(rdata);
 543   return rl;
 544 }
 545
 546 static void make_resultlist(Tcl_Interp *ip, adns_answer *answer,
 547                             Tcl_Obj *results[RESULTLIST_LLEN]) {
 548
 549   make_resultstatus(ip, answer->status, results);
 550   assert(RESULTSTATUS_LLEN==4);
 551   results[4]= cht_ret_string(ip, answer->owner);
 552   results[5]= cht_ret_string(ip, answer->cname ? answer->cname : "");
 553   results[6]= make_resultrdata(ip, answer);
 554 }
 555
 556 /*---------- synchronous query handling ----------*/
 557
 558 static int synch(Tcl_Interp *ip, const AdnsTclRRTypeInfo *rrtype,
 559                  const char *domain,
 560                  int objc, Tcl_Obj *const *objv, adns_answer **answer_r) {
 561   adns_query aqu;
 562   Resolver *res;
 563   int rc, ec;
 564
 565   rc= query_submit(ip,rrtype,domain,objc,objv,&aqu,0,&res);
 566   if (rc) return rc;
 567
 568   ec= adns_wait(res->ads,&aqu,answer_r,0);
 569   assert(!ec);
 570
 571   asynch_perturbed(res);
 572   return TCL_OK;
 573 }
 574
 575 int cht_do_adns_lookup(ClientData cd, Tcl_Interp *ip,
 576                    const AdnsTclRRTypeInfo *rrtype,
 577                    const char *domain,
 578                    int objc, Tcl_Obj *const *objv,
 579                    Tcl_Obj **result) {
 580   int rc;
 581   adns_answer *answer;
 582
 583   rc= synch(ip,rrtype,domain,objc,objv,&answer);  if (rc) return rc;
 584
 585   if (answer->status) {
 586     Tcl_Obj *problem[RESULTSTATUS_LLEN];
 587     make_resultstatus(ip, answer->status, problem);
 588     *result= Tcl_NewListObj(RESULTSTATUS_LLEN, problem);
 589   } else {
 590     *result= make_resultrdata(ip, answer);
 591   }
 592   free(answer);
 593   return TCL_OK;
 594 }
 595
 596 int cht_do_adns_synch(ClientData cd, Tcl_Interp *ip,
 597                   const AdnsTclRRTypeInfo *rrtype,
 598                   const char *domain,
 599                   int objc, Tcl_Obj *const *objv,
 600                   Tcl_Obj **result) {
 601   int rc;
 602   adns_answer *answer;
 603   Tcl_Obj *results[RESULTLIST_LLEN];
 604
 605   rc= synch(ip,rrtype,domain,objc,objv,&answer);  if (rc) return rc;
 606   make_resultlist(ip,answer,results);
 607   free(answer);
 608   *result= Tcl_NewListObj(RESULTLIST_LLEN, results);
 609   return TCL_OK;
 610 }
 611
 612 /*---------- asynchronous query handling ----------*/
 613
 614 struct Query {
 615   int ix; /* first! */
 616   Resolver *res;
 617   adns_query aqu;
 618   ScriptToInvoke on_yes, on_no, on_fail;
 619   Tcl_Obj *xargs;
 620 };
 621
 622 static void asynch_check_now(Resolver *res);
 623
 624 static void asynch_timerhandler(void *res_v) {
 625   Resolver *res= res_v;
 626   res->timertoken= 0;
 627   adns_processtimeouts(res->ads,0);
 628   asynch_check_now(res);
 629 }
 630
 631 static void asynch_filehandler(void *res_v, int mask) {
 632   Resolver *res= res_v;
 633   int ec;
 634
 635   ec= adns_processany(res->ads);
 636   if (ec) adns_globalsystemfailure(res->ads);
 637   asynch_check_now(res);
 638 }
 639
 640 static void asynch_sethandlers_generic(Resolver *res,
 641                                        int shutdown /*from _cancelhandlers*/,
 642                                        int immediate /*from _perturbed*/) {
 643   fd_set want[3];
 644   int maxfd;
 645   struct timeval tv_buf, *timeout;
 646   int i, fd;
 647
 648   timeout= 0;
 649   maxfd= 0;
 650   for (i=0; i<3; i++) FD_ZERO(&want[i]);
 651
 652   if (!shutdown)
 653     adns_beforeselect(res->ads,&maxfd,&want[0],&want[1],&want[2],
 654                       &timeout,&tv_buf,0);
 655
 656   for (fd= 0; fd < maxfd || fd < res->maxfd; fd++)
 657     for (i=0; i<3; i++)
 658       if (!!FD_ISSET(fd, &res->handling[i])
 659           != !!FD_ISSET(fd, &want[i])) {
 660         int mask=0;
 661         if (FD_ISSET(fd, &want[0])) mask |= TCL_READABLE;
 662         if (FD_ISSET(fd, &want[1])) mask |= TCL_WRITABLE;
 663         if (FD_ISSET(fd, &want[2])) mask |= TCL_EXCEPTION;
 664         if (mask) {
 665           Tcl_CreateFileHandler(fd,mask,asynch_filehandler,res);
 666           FD_SET(fd, &res->handling[i]);
 667         } else {
 668           Tcl_DeleteFileHandler(fd);
 669           FD_CLR(fd, &res->handling[i]);
 670         }
 671       }
 672   res->maxfd= maxfd;
 673
 674   Tcl_DeleteTimerHandler(res->timertoken);
 675
 676   if (immediate) {
 677     res->timertoken= Tcl_CreateTimerHandler(0,asynch_timerhandler,res);
 678   } else if (timeout) {
 679     int milliseconds;
 680
 681     if (timeout->tv_sec >= INT_MAX/1000 - 1)
 682       milliseconds= INT_MAX;
 683     else
 684       milliseconds= timeout->tv_sec * 1000 +
 685         (timeout->tv_usec + 999) / 1000;
 686
 687     res->timertoken=
 688       Tcl_CreateTimerHandler(milliseconds,asynch_timerhandler,res);
 689   }
 690 }
 691
 692 static void asynch_sethandlers(Resolver *res) {
 693   asynch_sethandlers_generic(res,0,0);
 694 }
 695 static void asynch_cancelhandlers(Resolver *res) {
 696   asynch_sethandlers_generic(res,1,0);
 697 }
 698 static void asynch_perturbed(Resolver *res) {
 699   asynch_sethandlers_generic(res,0,1);
 700 }
 701
 702 static void asynch_check_now(Resolver *res) {
 703   Tcl_Interp *interp= res->interp;
 704   adns_query aqu;
 705   adns_answer *answer;
 706   void *query_v;
 707   Query *query;
 708   ScriptToInvoke *si;
 709   int ec;
 710   Tcl_Obj *results[RESULTLIST_LLEN];
 711
 712   Tcl_Preserve(res);
 713
 714   for (;;) {
 715     if (!res->ads) { /* oh, it has been destroyed! */
 716       Tcl_Release(res);
 717       return;
 718     }
 719
 720     aqu= 0;
 721     ec= adns_check(res->ads, &aqu, &answer, &query_v);
 722     if (ec==ESRCH || ec==EAGAIN) break;
 723     assert(!ec);
 724     query= query_v;
 725
 726     query->aqu= 0;
 727     cht_tabledataid_disposing(interp, query, &cht_adnstcl_queries);
 728
 729     si= (!answer->status ? &query->on_yes
 730          : answer->status > adns_s_max_tempfail ? &query->on_no
 731          : &query->on_fail);
 732
 733     make_resultlist(interp, answer, results);
 734     free(answer);
 735     cht_scriptinv_invoke(si, RESULTLIST_LLEN, results);
 736     asynch_query_dispose(interp, query);
 737   }
 738
 739   asynch_sethandlers(res);
 740
 741   Tcl_Release(res);
 742 }
 743
 744 int cht_do_adns_asynch(ClientData cd, Tcl_Interp *ip,
 745                    Tcl_Obj *on_yes, Tcl_Obj *on_no,
 746                    Tcl_Obj *on_fail, Tcl_Obj *xargs,
 747                    const AdnsTclRRTypeInfo *rrtype, const char *domain,
 748                    int objc, Tcl_Obj *const *objv, void **result) {
 749   Query *query;
 750   int rc;
 751   Resolver *res= 0;
 752
 753   query= TALLOC(sizeof(*query));
 754   query->ix= -1;
 755   query->aqu= 0;
 756   cht_scriptinv_init(&query->on_yes);
 757   cht_scriptinv_init(&query->on_no);
 758   cht_scriptinv_init(&query->on_fail);
 759   query->xargs= 0;
 760
 761   rc= query_submit(ip,rrtype,domain,objc,objv,&query->aqu,query,&query->res);
 762   if (rc) goto x_rc;
 763
 764   res= query->res;
 765
 766   rc= cht_scriptinv_set(&query->on_yes, ip,on_yes, xargs);  if (rc) goto x_rc;
 767   rc= cht_scriptinv_set(&query->on_no,  ip,on_no,  xargs);  if (rc) goto x_rc;
 768   rc= cht_scriptinv_set(&query->on_fail,ip,on_fail,xargs);  if (rc) goto x_rc;
 769   query->xargs= xargs;
 770   Tcl_IncrRefCount(xargs);
 771   *result= query;
 772   query= 0; /* do not dispose */
 773   rc= TCL_OK;
 774
 775  x_rc:
 776   if (query) asynch_query_dispose(ip, query);
 777   if (res) asynch_perturbed(res);
 778   return rc;
 779 }
 780
 781 int cht_do_adns_asynch_cancel(ClientData cd, Tcl_Interp *ip, void *query_v) {
 782   Query *query= query_v;
 783   Resolver *res= query->res;
 784   asynch_query_dispose(ip, query);
 785   asynch_perturbed(res);
 786   return TCL_OK;
 787 }
 788
 789 static void asynch_query_dispose(Tcl_Interp *interp, Query *query) {
 790   cht_tabledataid_disposing(interp, query, &cht_adnstcl_queries);
 791   cht_scriptinv_cancel(&query->on_yes);
 792   cht_scriptinv_cancel(&query->on_no);
 793   cht_scriptinv_cancel(&query->on_fail);
 794   if (query->xargs) Tcl_DecrRefCount(query->xargs);
 795   if (query->aqu) adns_cancel(query->aqu);
 796   TFREE(query);
 797 }
 798
 799 static void destroy_query_idtabcb(Tcl_Interp *interp, void *query_v) {
 800   asynch_query_dispose(interp, query_v);
 801 }
 802
 803 const IdDataSpec cht_adnstcl_queries= {
 804   "adns", "adns-query-table", destroy_query_idtabcb
 805 };
 806
 807 /*---------- main hooks for tcl ----------*/
 808
 809 int cht_do_adnstoplevel_adns(ClientData cd, Tcl_Interp *ip,
 810                       const Adns_SubCommand *subcmd,
 811                       int objc, Tcl_Obj *const *objv) {
 812   return subcmd->func(0,ip,objc,objv);
 813 }
 814
 815 CHT_INIT(adns, {}, CHTI_COMMANDS(cht_adnstoplevel_entries))