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