From f432bd93079d2b88e100b9ec9b32d2fbd273b360 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 16 May 2020 13:11:28 +0000 Subject: [PATCH] * Patch from Noel Duffy to add TrySTrToHost* functions git-svn-id: trunk@45376 - --- .gitattributes | 1 + packages/rtl-extra/src/amiga/sockets.pp | 3 + packages/rtl-extra/src/aros/sockets.pp | 2 + packages/rtl-extra/src/inc/sockets.inc | 57 +++- packages/rtl-extra/src/inc/socketsh.inc | 5 +- packages/rtl-extra/src/netware/sockets.pp | 2 + packages/rtl-extra/src/netwlibc/sockets.pp | 2 + packages/rtl-extra/src/os2commn/sockets.pp | 2 + packages/rtl-extra/src/unix/sockets.pp | 1 + packages/rtl-extra/src/win/sockets.pp | 1 + tests/webtbs/tw37060.pp | 362 +++++++++++++++++++++ 11 files changed, 424 insertions(+), 14 deletions(-) create mode 100644 tests/webtbs/tw37060.pp diff --git a/.gitattributes b/.gitattributes index be1251bef1..a4948dae43 100644 --- a/.gitattributes +++ b/.gitattributes @@ -18286,6 +18286,7 @@ tests/webtbs/tw3695.pp svneol=native#text/plain tests/webtbs/tw3697.pp svneol=native#text/plain tests/webtbs/tw3700.pp svneol=native#text/plain tests/webtbs/tw37013.pp svneol=native#text/plain +tests/webtbs/tw37060.pp svneol=native#text/plain tests/webtbs/tw37062.pp svneol=native#text/pascal tests/webtbs/tw3708.pp svneol=native#text/plain tests/webtbs/tw3719.pp svneol=native#text/plain diff --git a/packages/rtl-extra/src/amiga/sockets.pp b/packages/rtl-extra/src/amiga/sockets.pp index bebfe0f160..50065d03f7 100644 --- a/packages/rtl-extra/src/amiga/sockets.pp +++ b/packages/rtl-extra/src/amiga/sockets.pp @@ -12,7 +12,10 @@ **********************************************************************} {$PACKRECORDS 2} {.$DEFINE SOCKETS_DEBUG} +{$ModeSwitch out} + unit Sockets; + Interface uses diff --git a/packages/rtl-extra/src/aros/sockets.pp b/packages/rtl-extra/src/aros/sockets.pp index d3c9d63620..d90fa78315 100644 --- a/packages/rtl-extra/src/aros/sockets.pp +++ b/packages/rtl-extra/src/aros/sockets.pp @@ -12,6 +12,8 @@ **********************************************************************} {$PACKRECORDS 2} {.$DEFINE SOCKETS_DEBUG} +{$ModeSwitch out} + unit Sockets; Interface diff --git a/packages/rtl-extra/src/inc/sockets.inc b/packages/rtl-extra/src/inc/sockets.inc index 17a60c5fc0..1ec407de68 100644 --- a/packages/rtl-extra/src/inc/sockets.inc +++ b/packages/rtl-extra/src/inc/sockets.inc @@ -302,6 +302,16 @@ begin end; function StrToHostAddr(IP : AnsiString) : in_addr ; +var + ip4: in_addr; +begin + ip4.s_addr := 0; + StrToHostAddr.s_addr:=0; //:=NoAddress; + if TryStrToHostAddr(IP, ip4) then + StrToHostAddr := ip4; +end; + +function TryStrToHostAddr(IP: AnsiString; out ip4: in_addr): Boolean; Const AllowedChars = ['.','0'..'9']; @@ -312,9 +322,10 @@ Var Temp : in_addr; begin - strtohostaddr.s_addr:=0; //:=NoAddress; + TryStrToHostAddr := False; + ip4.s_addr:=0; //:=NoAddress; for I:=1 to Length(IP) do - if Not (IP[I] in AllowedChars) then + if Not (IP[I] in AllowedChars) then exit; For I:=1 to 4 do begin @@ -328,8 +339,8 @@ begin end else Dummy:=IP; - if Length(Dummy)>3 then - exit; + if Length(Dummy)>3 then + exit; Val (Dummy,k,J); If J<>0 then exit; @@ -339,7 +350,8 @@ begin If array4int(temp.s_addr)[i]<>k then exit; end; - strtohostaddr.s_addr:=ntohl(Temp.s_addr); + ip4.s_addr:=ntohl(Temp.s_addr); + TryStrToHostAddr := True; end; function StrToNetAddr(IP : AnsiString) : in_addr; @@ -450,7 +462,24 @@ begin SetLength(HostAddrToStr6, Length(HostAddrToStr6)-1); end; -function StrToHostAddr6(IP: String): in6_addr; +function StrToHostAddr6(IP: AnsiString): in6_addr; +var + i6: in6_addr; +begin + i6.u6_addr32[0] := 0; + i6.u6_addr32[1] := 0; + i6.u6_addr32[2] := 0; + i6.u6_addr32[3] := 0; + StrToHostAddr6.u6_addr32[0] := 0; + StrToHostAddr6.u6_addr32[1] := 0; + StrToHostAddr6.u6_addr32[2] := 0; + StrToHostAddr6.u6_addr32[3] := 0; + + if TryStrToHostAddr6(IP, i6) then + StrToHostAddr6 := i6; +end; + +function TryStrToHostAddr6(IP: AnsiString; out ip6: in6_addr): Boolean; type TCharClass = (cHexDigit, cColon, cDot, cUnknown, cEndStr); TParserMode = (pmIPv6, pmIPv4); @@ -553,10 +582,11 @@ var tmpByte: Byte = 0; begin - StrToHostAddr6.s6_addr32[0] := 0; - StrToHostAddr6.s6_addr32[1] := 0; - StrToHostAddr6.s6_addr32[2] := 0; - StrToHostAddr6.s6_addr32[3] := 0; + TryStrToHostAddr6 := False; + ip6.s6_addr32[0] := 0; + ip6.s6_addr32[1] := 0; + ip6.s6_addr32[2] := 0; + ip6.s6_addr32[3] := 0; if (Length(IP) > 45) or (Length(IP) < 2) then exit; @@ -681,7 +711,7 @@ begin if coll_zero_seen then begin for tmpByte := 0 to coll_start_idx do - StrToHostAddr6.s6_addr16[tmpByte] := hextet_arr[tmpByte]; + ip6.s6_addr16[tmpByte] := hextet_arr[tmpByte]; // hextet_idx-1 points to the final byte we processed, in the hextet_arr // array. starting there, reading back to coll_start_idx, we copy these @@ -693,7 +723,7 @@ begin idx := 7; while tmpByte > coll_start_idx do begin - StrToHostAddr6.s6_addr16[idx] := hextet_arr[tmpByte]; + ip6.s6_addr16[idx] := hextet_arr[tmpByte]; Dec(tmpByte); Dec(idx); end; @@ -704,8 +734,9 @@ begin // NOTE: optimization note: memmove/memcpy equivalent could help here. if hextet_idx < 8 then exit; for tmpByte := 0 to 7 do - StrToHostAddr6.s6_addr16[tmpByte] := hextet_arr[tmpByte]; + ip6.s6_addr16[tmpByte] := hextet_arr[tmpByte]; end; + TryStrToHostAddr6 := True; end; function NetAddrToStr6 (Entry : TIn6_Addr) : ansiString; diff --git a/packages/rtl-extra/src/inc/socketsh.inc b/packages/rtl-extra/src/inc/socketsh.inc index 09bc013251..858b241f40 100644 --- a/packages/rtl-extra/src/inc/socketsh.inc +++ b/packages/rtl-extra/src/inc/socketsh.inc @@ -193,6 +193,8 @@ function HostAddrToStr(Entry : in_addr) : AnsiString; function StrToHostAddr(IP : AnsiString) : in_addr ; function StrToNetAddr (IP : AnsiString) : in_addr; +function TryStrToHostAddr(IP : AnsiString; out ip4: in_addr) : Boolean ; + { these for are for netdb legacy compat} Function HostToNet (Host : in_addr) : in_addr; deprecated; Function NetToHost (Net : in_addr) : in_addr; deprecated; @@ -203,9 +205,10 @@ Function ShortNetToHost(Net : Word) : Word; deprecated; // ipv6 function HostAddrToStr6(Entry : Tin6_addr) : AnsiString; -function StrToHostAddr6(IP : String) : Tin6_addr; // not implemented?!? +function StrToHostAddr6(IP : AnsiString) : Tin6_addr; // not implemented?!? function NetAddrToStr6 (Entry: Tin6_addr) : AnsiString; function StrToNetAddr6 (IP : AnsiString) : TIn6_Addr; +function TryStrToHostAddr6(IP: AnsiString; out ip6: in6_addr): Boolean; CONST NoAddress : in_addr = (s_addr:0); diff --git a/packages/rtl-extra/src/netware/sockets.pp b/packages/rtl-extra/src/netware/sockets.pp index 640135c0a4..e461a464ec 100644 --- a/packages/rtl-extra/src/netware/sockets.pp +++ b/packages/rtl-extra/src/netware/sockets.pp @@ -12,6 +12,8 @@ **********************************************************************} {$mode objfpc} +{$ModeSwitch out} + unit Sockets; Interface diff --git a/packages/rtl-extra/src/netwlibc/sockets.pp b/packages/rtl-extra/src/netwlibc/sockets.pp index ab8bb76a53..ec1090dcc8 100644 --- a/packages/rtl-extra/src/netwlibc/sockets.pp +++ b/packages/rtl-extra/src/netwlibc/sockets.pp @@ -12,6 +12,8 @@ **********************************************************************} {$mode objfpc} +{$ModeSwitch out} + unit Sockets; Interface diff --git a/packages/rtl-extra/src/os2commn/sockets.pp b/packages/rtl-extra/src/os2commn/sockets.pp index 01d4bb1e94..6dcfab68c1 100644 --- a/packages/rtl-extra/src/os2commn/sockets.pp +++ b/packages/rtl-extra/src/os2commn/sockets.pp @@ -16,6 +16,8 @@ {$MODE ObjFPC} { $DEFINE notUnix} // To make ssockets.pp compile +{$ModeSwitch out} + unit Sockets; interface diff --git a/packages/rtl-extra/src/unix/sockets.pp b/packages/rtl-extra/src/unix/sockets.pp index 234afe3b89..65644b04ca 100644 --- a/packages/rtl-extra/src/unix/sockets.pp +++ b/packages/rtl-extra/src/unix/sockets.pp @@ -12,6 +12,7 @@ **********************************************************************} unit Sockets; Interface +{$ModeSwitch out} {$ifdef Unix} Uses baseunix,UnixType; diff --git a/packages/rtl-extra/src/win/sockets.pp b/packages/rtl-extra/src/win/sockets.pp index 561dbf8226..d97f6f0816 100644 --- a/packages/rtl-extra/src/win/sockets.pp +++ b/packages/rtl-extra/src/win/sockets.pp @@ -11,6 +11,7 @@ **********************************************************************} {$mode objfpc} +{$ModeSwitch out} unit Sockets; Interface diff --git a/tests/webtbs/tw37060.pp b/tests/webtbs/tw37060.pp new file mode 100644 index 0000000000..c167a50887 --- /dev/null +++ b/tests/webtbs/tw37060.pp @@ -0,0 +1,362 @@ +program fp37060; + +{$mode objfpc}{$H+} + +uses sockets, Classes, SysUtils; + +procedure BuildBadAddrs4(out bad_addrs: TStringList); +begin + bad_addrs.Add('1.1.1.1.1'); // too many octets + bad_addrs.Add('0xa.3.4.5'); //hex in octets + bad_addrs.Add('9.$c.4.5'); //hex in octets + bad_addrs.Add('12.$2.1.1.1'); //hex in octets + bad_addrs.Add('000001.2.3.4'); // too many digits in octet + bad_addrs.Add('1.000002.3.4'); // ditto second octet + bad_addrs.Add('1.2.000003.4'); // ditto third octet + bad_addrs.Add('1.2.3.000004'); // ditto fourth octet + bad_addrs.Add('1.2.3.+4'); // math sign in octet + bad_addrs.Add('1.2.-3.4'); // math sign in octet + bad_addrs.Add('1.+2.3.4'); // math sign in octet + bad_addrs.Add('-1.2.3.4'); // math sign in octet + bad_addrs.Add('192.168.1'); // too few octets + bad_addrs.Add('192.168'); // fewer still + bad_addrs.Add('192'); // just one octet + bad_addrs.Add('172.16.231.25.'); // ends with dot + bad_addrs.Add('.172.16.231.25'); // starts with dot + bad_addrs.Add('10...'); // dots but no digits + bad_addrs.Add('310.259.1.1'); // overflow in octet 1 + bad_addrs.Add('10.259.1.1'); // ditto octet 2 + bad_addrs.Add('10.25.300.1'); // ditto octet 3 + bad_addrs.Add('10.25.30.301'); //ditto octet 4 + bad_addrs.Add('%1111.%11001110.30.4'); // binary + bad_addrs.Add('&7.&5.30.4'); // octal +end; + +procedure BuildGoodAddrs4(out good_addrs: TStringList); +begin + good_addrs.Add('127.0.0.1|127.0.0.1'); + good_addrs.Add('0.0.0.0|0.0.0.0'); + good_addrs.Add('172.16.31.241|172.16.31.241'); + good_addrs.Add('255.255.255.255|255.255.255.255'); +end; + +procedure BuildBadAddrs6(out bad_addrs: TStringList); +begin + // start with some obviously bad formats. + bad_addrs.Add(''); + bad_addrs.Add(':'); + bad_addrs.Add(':::'); + bad_addrs.Add('::.'); + bad_addrs.Add('::::'); + bad_addrs.Add('fe80:'); + bad_addrs.Add('x:'); + bad_addrs.Add('.'); + bad_addrs.Add('....'); + + // invalid chars in all 8 hextets. + bad_addrs.Add('fe@0:b46c:c2a1:a202:9*6e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b4%c:c2a1:a202:9*6e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2#1:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a2^2:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:9*6e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9!d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:a=20:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:a520:41+2'); + + // $ sign in hextets. + bad_addrs.Add('$fe80:b46c:c2a1:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b$46c:c2a1:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1$:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926$e:9d2f:a520:4172'); + + // last char is : + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:a520:4172:'); + + // first char is : + bad_addrs.Add(':fe80:b46c:c2a1:a202:926e:9d2f:a520:4172'); + + // two sequences of collapsed zeroes. :: is the Highlander + // sequence. There can be only one. + bad_addrs.Add('fe80::c2a1:a202::9d2f:a520:4172'); + + // 8 hextets plus collapsed zeroes, which means at least 1 hextet + // of all zeroes, equaling 9 hextets. + bad_addrs.Add('fe80:b46c:c2a1::a202:926e:9d2f:a520:4172'); + + // try the same with the :: at the start. + bad_addrs.Add('::b46c:c2a1:8fcb:a202:926e:9d2f:a520:4172'); + + // and now try the same with the :: at the ned. + bad_addrs.Add('b46c:a771:8fcb:a202:926e:9d2f:a520:4172::'); + + // too many hextets + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:a520:4172:1211'); + + // too few hextets + bad_addrs.Add('fe80:b46c:9d2f:a520:4172:1211'); + + // too many digits in each of the 8 hextets + bad_addrs.Add('fe801:b46c:c2a1:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46cb:c2a1:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:0c2ad:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a2022:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e6:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:09d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:a5209:4172'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:a520:04172'); + + // math signs in hextets. naive parsing of hextets with + // math signs produces a positive result, but these are not + // valid. + bad_addrs.Add('fe80:-b46c:c2a1:a202:926e:9d2f:a520:4172'); + bad_addrs.Add('fe80:b46c:-c2a1:a202:926e:9d2f:a520:4172'); + + // Hybrid 6 and 4 addresses. + + // ipv4 octet can't contain hex + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:19F.168.1.2'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.1A8.1.2'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.B.2'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.1.C'); + + // ipv4 octets can't contain math signs + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:-192.168.1.1'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.-168.1.1'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.-1.1'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.1.-1'); + + // invalid hybrid ipv6/ipv4 address, because there are 7 + // hextets before the ipv4. there can be only 6, as the 4 + // octets make up 2 hextets, and there can be no more than 8 + // hextets in total. + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:a520:192.168.1.2'); + + // 5 hextets plus 2 hextets (4 octets) = 7. Must be 8. + bad_addrs.Add('fe80:b46c:926e:9d2f:a520:192.168.1.2'); + + // too few octets in ipv4 bit. + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.1'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192'); + + // 7 hextets plus two octets of ipv4 = 8 hextets, but still must + // not be parsed as valid because there must be 4 octets. + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:e2fc:192.168'); + + // too many ipv4 octets + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.1.17.32'); + + // addr starts with . + bad_addrs.Add('.fe80:b46c:c2a1:a202:926e:9d2f:192.168.1.17'); + // addr ends with . + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.1.17.'); + + // 6 hextets + 2 hextets (4 octets) plus collapsed zero sequence = 9 hextets. + bad_addrs.Add('fe80:b46c::c2a1:a202:926e:9d2f:72.16.32.1'); + + // repeat with :: at start + bad_addrs.Add('::fe80:b46c:c2a1:a202:926e:9d2f:72.16.32.1'); + // and at end + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f::72.16.32.1'); + + // ipv4 octets > 255 + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:351.16.32.1'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:72.123216.32.1'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:72.16.9999999999999999999.1'); + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:72.16.32.5e21'); + + // dot sequence + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192..168.1.17'); + + // start with dot + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:.192.168.1.17'); + + // end with dot + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:9d2f:192.168.1.17.'); + + // ipv4 octets followed by hextet + bad_addrs.Add('fe80:b46c:c2a1:a202:926e:192.168.1.1:a2c1'); + + // all zeroes but for mathematical operator. + bad_addrs.Add('::-'); + + // end on colon, but with earlier collapsed section. + bad_addrs.Add('fe80::a202:926e:a2c1:'); + + // too many digits in ipv4 octet + bad_addrs.Add('21ac:d349:07c4:198e:6fab:df5a:0192.168.1.17'); + bad_addrs.Add('21ac:d349:07c4:198e:6fab:df5a:192.0168.1.17'); + bad_addrs.Add('21ac:d349:07c4:198e:6fab:df5a:192.168.0001.17'); + bad_addrs.Add('21ac:d349:07c4:198e:6fab:df5a:192.0168.1.0017'); + + // just ipv4 address + bad_addrs.Add('127.0.0.2'); +end; + +procedure BuildGoodAddrs6(out addrlist: TStringList); +begin + // Each str is two parts, separated by a pipe. The left part is the input + // address to be parsed, and the right is the expected result of taking the + // resulting address and converting back to a string. This provides an + // easy way to verify that the StrToHostAddr6 function parsed the address + // correctly. + // The values on the right have been double-checked with libc's inet_pton. + addrlist.Add('::1|::0001'); + addrlist.Add('::|::'); + addrlist.Add('2001:4860:4000::|2001:4860:4000::'); + addrlist.Add('21ac:d349:07c4:198e:6fab:df5a:192.168.1.17|21AC:D349:07C4:198E:6FAB:DF5A:C0A8:0111'); + addrlist.Add('21ac:d349:07c4:198e:6fab:df5a:0.0.0.0|21AC:D349:07C4:198E:6FAB:DF5A::'); + addrlist.Add('::213.41.35.14|::D529:230E'); + addrlist.Add('fe80:b46c:c2a1:a202:926e:9d2f:a520:4172|FE80:B46C:C2A1:A202:926E:9D2F:A520:4172'); + addrlist.Add('a:b:c:d:e:f:0:1|000A:000B:000C:000D:000E:000F::0001'); + addrlist.Add('a:B:c:D:e:f:9:1|000A:000B:000C:000D:000E:000F:0009:0001'); + addrlist.Add('::0.0.0.0|::'); +end; + +function TestAddrs4(al: TStringList): Cardinal; +var + bad_addr: String; + i4: in_addr; + res: Boolean; +begin + Result := 0; + for bad_addr in al do + begin + res := TryStrToHostAddr(bad_addr, i4); + if res = True then + begin + writeln(' [x] '+bad_addr); + Inc(Result); + end; + end; +end; + +function TestGoodAddrs4(al: TStringList): Cardinal; +var + addr,instr,parsed_addr,expected: String; + i4: in_addr; + idx: Cardinal; + res: Boolean; +begin + Result := 0; + for addr in al do + begin + idx := Pos('|', addr); + if idx > 0 then + begin + instr := Copy(addr,1,idx-1); + res := TryStrToHostAddr(instr, i4); + if res = False then + begin + writeln(' [x] '+instr); + exit; + end; + expected := Copy(addr, idx+1, Length(addr)-idx); + parsed_addr := HostAddrToStr(i4); + if parsed_addr <> expected then + writeln(' [X] "'+instr+' -> '+parsed_addr) + else + Inc(Result); + end; + end; +end; + +function TestAddrs6(al: TStringList): Cardinal; +var + bad_addr: String; + i6: in6_addr; + res: Boolean; +begin + Result := 0; + for bad_addr in al do + begin + res := TryStrToHostAddr6(bad_addr, i6); + if res = True then + begin + writeln(' [x] '+bad_addr); + Inc(Result); + end; + end; +end; + +function TestGoodAddrs6(al: TStringList): Cardinal; +var + addr,instr,parsed_addr,expected: String; + i6: in6_addr; + idx: Cardinal; + res: Boolean; +begin + Result := 0; + for addr in al do + begin + idx := Pos('|', addr); + if idx > 0 then + begin + instr := Copy(addr,1,idx-1); + res := TryStrToHostAddr6(instr, i6); + if res = False then + begin + writeln(' [x] '+instr); + exit; + end; + expected := Copy(addr, idx+1, Length(addr)-idx); + parsed_addr := HostAddrToStr6(i6); + if parsed_addr <> expected then + writeln(' [X] "'+instr+' -> '+parsed_addr) + else + Inc(Result); + end; + end; +end; + +var + addrlist: TStringList; + count: Cardinal; +begin + ExitCode := 0; + addrlist := TStringList.Create; + + // IPv4 Tests + + writeln('IPv4'); + BuildBadAddrs4(addrlist); + count := TestAddrs4(addrlist); + writeln('Got True result for '+inttostr(count)+' out of '+ + inttostr(addrlist.Count)+' ip4 bad addresses.'); + // if we successfully parsed any bad addresses + if count > 0 then ExitCode := 1; + + addrlist.Clear; + BuildGoodAddrs4(addrlist); + count := TestGoodAddrs4(addrlist); + writeln('Got True result for '+inttostr(count)+' out of '+ + inttostr(addrlist.Count)+' good ip4 addresses.'); + writeln(); + + // if we didn't parse all the good addresses. + if count < addrlist.Count then + ExitCode := 1; + + // IPv6 Tests + + writeln('IPv6'); + BuildBadAddrs6(addrlist); + count := TestAddrs6(addrlist); + writeln('Got True result for '+inttostr(count)+' out of '+ + inttostr(addrlist.Count)+' ip6 bad addresses.'); + // if we successfully parsed any bad addresses + if count > 0 then ExitCode := 1; + + addrlist.Clear; + BuildGoodAddrs6(addrlist); + count := TestGoodAddrs6(addrlist); + writeln('Got True result for '+inttostr(count)+' out of '+ + inttostr(addrlist.Count)+' good ip6 addresses.'); + + // if we didn't parse all the good addresses. + if count < addrlist.Count then + ExitCode := 1; + + addrlist.Free; +end. +