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