/pliant/protocol/dns/client.pli
1	abstract
2	[This is a DNS client implementation, according to RFC 1035.]
3
4	module "/pliant/language/compiler.pli"
5	module "/pliant/language/context.pli"
6	module "common.pli"
7	module "name.pli"
8	module "/pliant/language/os/socket.pli"
9
10
11	doc
12	[Use field=1 to get the A field (IP address).] ; eol
13	[Use field=15 to get the MX field (mail server name of the domain).] ; eol
14	para
15	[The 'dns_query' function works in three stages:]
16	list
17	item [First it will build the query packet.]
18	item [Second, it calls 'query_cache', and 'query_providers' is the answer was not cached yet, to get the answer packet.]
19	item [Third, it parses the answer packet to get the requested field.]
20	[So, this client implementation will benefit from caching just like the server does.]
21
22
23	function dns_query name field dns timeout -> answer
24	arg Str name ; arg Int field ; arg Str dns ; arg Float timeout ; arg Str answer
25	if field=1 and dns:len=0
26	answer := name_ip name
27	if answer<>""
28	return
29	if field=15 and dns:len=0
30	var Data:NameDomain d :> name_database:data:domain name
31	if exists:d
32	answer := ""
33	each m d:mail
34	answer += (shunt answer:len>0 " " "")+m
35	return
36	var CBool use_cache := dns=""
37	var Str name2 := name ; var Int count := 3
38	part query_name
39	answer := ""
40	var Int limit := 512
41	var Address buf := memory_allocate limit null
42	var Pointer:DnsHeader h :> buf map DnsHeader ; var Int offset := DnsHeader size
43	h id := 0
44	h flags := 100h
45	h qdcount := 1
46	h ancount := 0
47	h nscount := 0
48	h arcount := 0
49	write_name buf offset limit name2
50	var Pointer:DnsTail t :> (buf translate Byte offset) map DnsTail ; offset += DnsTail size
51	t qtype := field
52	t qclass := 1
53	(var Str raw_query) set buf offset true
54	var Str raw_answer
55	if dns<>""
56	raw_answer := query_provider raw_query dns timeout
57	eif use_cache
58	raw_answer := query_cache raw_query
59	if raw_answer=""
60	raw_answer := query_providers raw_query
61	else
62	raw_answer := query_providers raw_query
63	buf := raw_answer characters ; limit := raw_answer len
64	if DnsHeader:size>limit
65	return
66	h :> buf map DnsHeader ; offset := DnsHeader size
67	var Str alias := name2
68	var Index mail_servers
69	for (var Int i) 0 h:qdcount+h:ancount+h:nscount-1
70	var Str id := read_name buf offset limit
71	if offset+DnsTail:size>limit
72	return
73	var Pointer:DnsTail t :> (buf translate Byte offset) map DnsTail ; offset += DnsTail size
74	if i>=h:qdcount
75	if offset+DnsAnswer:size>limit
76	return
77	var Pointer:DnsAnswer a :> (buf translate Byte offset) map DnsAnswer ; offset += DnsAnswer size
78	if offset+a:rdlength>limit
79	return
80	if t:qtype=1 and a:rdlength=4
81	var Str ip := ""
82	for (var Int j) 0 3
83	ip += (shunt j=0 "" ".")+string:(cast ((buf translate Byte offset+j) map uInt8) Int)
84	if id=alias and field=1
85	answer := ip
86	eif t:qtype=5
87	if id=alias
88	var Int offset2 := offset ; alias := read_name buf offset2 limit
89	eif t:qtype=15 and a:rdlength>=3
90	if id=alias and field=15
91	var Int priority := (buf translate Byte offset) map uInt16_hi
92	var Int offset2 := offset+uInt16:size ; var Str mailserver := read_name buf offset2 limit
93	mail_servers insert (right string:priority 5 " ") addressof:(new Str mailserver)
94	eif t:qtype=16 and a:rdlength>=1
95	if id=alias
96	answer set (memory_allocate a:rdlength-1 addressof:answer) a:rdlength-1 true
97	memory_copy (buf translate Byte offset+1) answer:characters a:rdlength-1
98	offset += a:rdlength
99	if field=15
100	var Pointer:Arrow cursor :> mail_servers first
101	while cursor<>null
102	answer += (shunt answer:len>0 " " "")+(cursor map Str)
103	cursor :> mail_servers next cursor
104	if answer="" and alias<>name2 and count>0
105	name2 := alias ; count -= 1
106	restart query_name
107	if answer="" and use_cache
108	use_cache := false
109	restart query_name
110
111	function dns_query name field -> answer
112	arg Str name ; arg Int field ; arg Str answer
113	answer := dns_query name field "" 0
114
115	constant os_resolution  (dns_query_os "www.debian.org")<>""
116	constant direct_resolution (dns_query "www.debian.org" 1)<>""
117	if os_resolution and not direct_resolution
118	compile_log "Using "+os_api+" API for name -> IP address resolution."
119
120	function dns_query name -> answer
121	arg Str name; arg Str answer
122	answer := dns_query name 1
123	if os_resolution and not direct_resolution
124	if answer=""
125	answer := dns_query_os name
126
127	dns_query_function :> the_function dns_query Str -> Str
128
129	export dns_query