Hi, I've adjusted the netdb code to actually fix some things and resolve ipv6 addresses, and follow cname pointers..
Attached is a patch :-) Also attached is a test program but that will only work if you have ipv6 enabled and are connected to 6bone in some way. You can test the cname resolving anyway though. And the test program needs my other patch with ipv6 structures to work. johannes -- http://www.sipsolutions.de/ GnuPG key: http://www.sipsolutions.de/keys/JohannesBerg.asc Key-ID: 9AB78CA5 Johannes Berg <[EMAIL PROTECTED]> Fingerprint = AD02 0176 4E29 C137 1DF6 08D2 FC44 CF86 9AB7 8CA5
program ip6test;
uses
sockets,
unix,
errors,
netdb,
baseunix;
var
dest: TInetSockAddr6;
sock: LongInt;
s: shortstring;
i: integer;
t1,t2:text;
x: array of thostaddr6;
begin
setlength(x, 100);
setlength(x,resolvename6('www.6bone.net', x));
if length(x) = 0 then halt(2);
with dest do begin
sin6_family := PF_INET6;
sin6_port := shorthosttonet(80);
sin6_addr.u6_addr16 := x[0];
end;
sock := socket(PF_INET6, SOCK_STREAM, 6 {TCP});
if Connect(sock, dest, sizeof(dest)) then begin
sock2text(sock,t1,t2);
writeln(t2, 'GET / HTTP/1.0');
writeln(t2);
while not eof(t1) do begin
readln(t1, s);
writeln(s);
end;
end else begin
writeln('not connected: ',getlasterror, ': ', StrError(getlasterror));
end;
closesocket(sock);
end.
? Package.fpc
? fpcmade.freebsd
? fpcmade.lnx
? netdb.ppu
? uriparser.ppu
Index: hs.inc
===================================================================
RCS file: /FPC/CVS/fpc/packages/base/netdb/hs.inc,v
retrieving revision 1.1
diff -u -r1.1 hs.inc
--- hs.inc 6 Mar 2003 22:41:37 -0000 1.1
+++ hs.inc 22 Nov 2003 22:04:40 -0000
@@ -107,3 +107,72 @@
ShortNetToHost:=lo(Net)*256+Hi(Net);
end;
+
+
+function HostAddrToStr6 (Entry : THostAddr6) : String;
+var
+ i: byte;
+ zr1,zr2: set of byte;
+ zc1,zc2: byte;
+ have_skipped: boolean;
+begin
+ zr1 := [];
+ zr2 := [];
+ zc1 := 0;
+ zc2 := 0;
+ for i := 0 to 7 do begin
+ if Entry[i] = 0 then begin
+ include(zr2, i);
+ inc(zc2);
+ end else begin
+ if zc1 < zc2 then begin
+ zc1 := zc2;
+ zr1 := zr2;
+ zc2 := 0; zr2 := [];
+ end;
+ end;
+ end;
+ if zc1 < zc2 then begin
+ zc1 := zc2;
+ zr1 := zr2;
+ end;
+ SetLength(HostAddrToStr6, 8*5-1);
+ SetLength(HostAddrToStr6, 0);
+ have_skipped := false;
+ for i := 0 to 7 do begin
+ if not (i in zr1) then begin
+ if have_skipped then begin
+ if HostAddrToStr6 = ''
+ then HostAddrToStr6 := '::'
+ else HostAddrToStr6 := HostAddrToStr6 + ':';
+ have_skipped := false;
+ end;
+ // FIXME: is that shortnettohost really proper there? I wouldn't be too sure...
+ HostAddrToStr6 := HostAddrToStr6 + IntToHex(ShortNetToHost(Entry[i]), 1) + ':';
+ end else begin
+ have_skipped := true;
+ end;
+ end;
+ if have_skipped then
+ if HostAddrToStr6 = ''
+ then HostAddrToStr6 := '::'
+ else HostAddrToStr6 := HostAddrToStr6 + ':';
+
+ if HostAddrToStr6 = '' then HostAddrToStr6 := '::';
+ if not (7 in zr1) then
+ SetLength(HostAddrToStr6, Length(HostAddrToStr6)-1);
+end;
+
+function StrToHostAddr6(IP : String) : THostAddr6;
+begin
+end;
+
+function NetAddrToStr6 (Entry : TNetAddr6) : String;
+begin
+ Result := HostAddrToStr6(Entry);
+end;
+
+function StrToNetAddr6(IP : String) : TNetAddr6;
+begin
+ Result := StrToHostAddr6(IP);
+end;
Index: hsh.inc
===================================================================
RCS file: /FPC/CVS/fpc/packages/base/netdb/hsh.inc,v
retrieving revision 1.1
diff -u -r1.1 hsh.inc
--- hsh.inc 6 Mar 2003 22:41:37 -0000 1.1
+++ hsh.inc 22 Nov 2003 22:04:41 -0000
@@ -5,10 +5,18 @@
TNetAddr = THostAddr;
PNetAddr = ^TNetAddr;
+ THostAddr6 = array[0..7] of word;
+ PHostAddr6 = ^THostAddr6;
+ TNetAddr6 = THostAddr6;
+ PNetAddr6 = ^TNetAddr6;
+
Const
NoAddress : THostAddr = (0,0,0,0);
NoNet : TNetAddr = (0,0,0,0);
+ NoAddress6 : THostAddr6 = (0,0,0,0,0,0,0,0);
+ NoNet6: THostAddr6 = (0,0,0,0,0,0,0,0);
+
function HostAddrToStr (Entry : THostAddr) : String;
function StrToHostAddr(IP : String) : THostAddr ;
function NetAddrToStr (Entry : TNetAddr) : String;
@@ -19,3 +27,9 @@
Function NetToHost (Net : Longint) : Longint;
Function ShortHostToNet (Host : Word) : Word;
Function ShortNetToHost (Net : Word) : Word;
+
+
+function HostAddrToStr6 (Entry : THostAddr6) : String;
+function StrToHostAddr6(IP : String) : THostAddr6;
+function NetAddrToStr6 (Entry : TNetAddr6) : String;
+function StrToNetAddr6(IP : String) : TNetAddr6;
Index: netdb.pp
===================================================================
RCS file: /FPC/CVS/fpc/packages/base/netdb/netdb.pp,v
retrieving revision 1.7
diff -u -r1.7 netdb.pp
--- netdb.pp 29 Sep 2003 19:21:19 -0000 1.7
+++ netdb.pp 22 Nov 2003 22:04:41 -0000
@@ -30,6 +30,8 @@
SServicesFile = '/etc/services';
SHostsFile = '/etc/hosts';
SNetworksFile = '/etc/networks';
+
+ MaxRecursion = 10;
Type
TDNSServerArray = Array[1..MaxServers] of THostAddr;
@@ -63,6 +65,9 @@
Function GetDNSServers(FN : String) : Integer;
Function ResolveName(HostName : String; Var Addresses : Array of THostAddr) : Integer;
+Function ResolveName6(HostName : String; Var Addresses : Array of THostAddr6) : Integer;
+
+
Function ResolveAddress(HostAddr : THostAddr; Var Addresses : Array of String) : Integer;
Function ResolveHostByName(HostName : String; Var H : THostEntry) : Boolean;
@@ -90,11 +95,14 @@
{$i hs.inc}
const
+ { from http://www.iana.org/assignments/dns-parameters }
DNSQRY_A = 1; // name to IP address
DNSQRY_AAAA = 28; // name to IP6 address
+ DNSQRY_A6 = 38; // name to IP6 (new)
DNSQRY_PTR = 12; // IP address to name
DNSQRY_MX = 15; // name to MX
DNSQRY_TXT = 16; // name to TXT
+ DNSQRY_CNAME = 5;
// Flags 1
QF_QR = $80;
@@ -155,6 +163,7 @@
{$else}
result := w;
{$endif}
+ w := result;
end;
Function ntohs(var W : Word) : Word;
@@ -165,6 +174,7 @@
{$else}
result := w;
{$endif}
+ w := result;
end;
function ntohl(i:integer):integer;
@@ -174,6 +184,7 @@
{$else}
result := i;
{$endif}
+ i := result;
end;
{ ---------------------------------------------------------------------
@@ -544,6 +555,91 @@
Result:=ResolveNameAt(I,HostName,Addresses);
Inc(I);
end;
+end;
+
+function stringfromlabel(pl: TPayLoad; start: integer): string;
+var
+ l,i: integer;
+begin
+ result := '';
+ l := 0;
+ i := 0;
+ repeat
+ l := ord(pl[start]);
+ if l <> 0 then begin
+ setlength(result,length(result)+l);
+ move(pl[start+1],result[i+1],l);
+ result := result + '.';
+ inc(start,l); inc(start);
+ inc(i,l); inc(i);
+ end;
+ until l = 0;
+ if result[length(result)] = '.' then setlength(result,length(result)-1);
+end;
+
+Function ResolveNameAt6(Resolver : Integer; HostName : String; Var Addresses : Array of THostAddr6; Recurse: Integer) : Integer;
+
+Var
+ Qry, Ans : TQueryData;
+ MaxAnswer,I,QryLen,
+ AnsLen,AnsStart : Longint;
+ RR : TRRData;
+ cname : string;
+
+begin
+ Result:=0;
+ QryLen:=BuildPayLoad(Qry,HostName,DNSQRY_AAAA,1);
+ If Not Query(Resolver,Qry,Ans,QryLen,AnsLen) then
+ Result:=-1
+ else
+ begin
+ AnsStart:=SkipAnsQueries(Ans,AnsLen);
+ MaxAnswer:=Ans.AnCount-1;
+ If MaxAnswer>High(Addresses) then
+ MaxAnswer:=High(Addresses);
+ I:=0;
+ While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
+ begin
+ if (1=NtoHS(RR.AClass)) then
+ case ntohs(rr.atype) of
+ DNSQRY_AAAA: begin
+ Move(Ans.PayLoad[AnsStart],Addresses[i],SizeOf(THostAddr6));
+ inc(Result);
+ rr.rdlength := ntohs(rr.rdlength);
+ Inc(AnsStart,RR.RDLength);
+ end;
+ DNSQRY_CNAME: begin
+ if Recurse >= MaxRecursion then begin
+ Result := -1;
+ exit;
+ end;
+ rr.rdlength := ntohs(rr.rdlength);
+ writeln(rr.rdlength);
+ setlength(cname, rr.rdlength);
+ cname := stringfromlabel(ans.payload, ansstart);
+ writeln(cname);
+ Result := ResolveNameAt6(Resolver, cname, Addresses, Recurse+1);
+ exit; // FIXME: what about other servers?!
+ end;
+ end;
+ Inc(I);
+ end;
+ end;
+end;
+
+
+
+Function ResolveName6(HostName: String; Var Addresses: Array of THostAddr6) : Integer;
+var
+ i: Integer;
+begin
+ CheckResolveFile;
+ i := 1;
+ Result := 0;
+ while (Result = 0) and (I<= DNSServerCount) do begin
+ Result := ResolveNameAt6(I, Hostname, Addresses, 0);
+ Inc(i);
+ end;
end;
Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String) : Integer;
signature.asc
Description: This is a digitally signed message part
