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