adns/adns.c

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