Skip to content

Commit

Permalink
better ipv6 support
Browse files Browse the repository at this point in the history
  • Loading branch information
rejetto committed May 23, 2020
1 parent 72b28af commit 45f3896
Show file tree
Hide file tree
Showing 3 changed files with 126 additions and 101 deletions.
21 changes: 12 additions & 9 deletions hslib.pas
Original file line number Diff line number Diff line change
Expand Up @@ -370,6 +370,8 @@ function isLocalIP(ip:string):boolean;
var
r: record d,c,b,a:byte end;
begin
if ip = '::1' then
exit(TRUE);
dword(r):=WSocket_ntohl(WSocket_inet_addr(ansiString(ip)));
result:=(r.a in [0,10,23,127])
or (r.a = 192) and ((r.b = 168) or (r.b = 0) and (r.c = 2))
Expand Down Expand Up @@ -670,15 +672,16 @@ function ThttpSrv.start(onAddress:string='*'):boolean;
P_port:=sock.getxport();
result:=TRUE;

try
sock.MultiListenSockets.Clear();
with sock.MultiListenSockets.Add do
begin
addr := '::';
Port := sock.port
end;
sock.MultiListen();
except end;
if onAddress = '*' then
try
sock.MultiListenSockets.Clear();
with sock.MultiListenSockets.Add do
begin
addr := '::';
Port := sock.port
end;
sock.MultiListen();
except end;

notify(HE_OPEN, NIL);
except
Expand Down
55 changes: 29 additions & 26 deletions main.pas
Original file line number Diff line number Diff line change
Expand Up @@ -4256,6 +4256,13 @@ procedure kickBannedOnes();
end;
end; // kickBannedOnes

function getAcceptOptions():TstringDynArray;
begin
result:=listToArray(localIPlist(sfAny));
addUniqueString('127.0.0.1', result);
addUniqueString('::1', result);
end; // getAcceptOptions

function startServer():boolean;

procedure tryPorts(list:array of string);
Expand All @@ -4273,7 +4280,7 @@ function startServer():boolean;
result:=FALSE;
if srv.active then exit; // fail if already active

if (localIPlist.IndexOf(listenOn) < 0) and (listenOn <> '127.0.0.1') then
if not stringExists(listenOn, getAcceptOptions()) then
listenOn:='';

if port > '' then
Expand Down Expand Up @@ -5911,19 +5918,16 @@ procedure Tmainfrm.httpEvent(event:ThttpEvent; conn:ThttpConn);

procedure findSimilarIP(fromIP:string);

function howManySameNumbers(ip1,ip2:string):integer;
function howManySameChars(ip1,ip2:string):integer;
var
n1, n2: string;
i,n: integer;
begin
result:=0;
while ip1 > '' do
begin
n1:=chop('.',ip1);
n2:=chop('.',ip2);
if n1 <> n2 then exit;
inc(result);
end;
end; // howManySameNumbers
i:=1;
n:=min(length(ip1),length(ip2));
while (i<=n) and (ip1[i] = ip2[i]) do
inc(i);
result:=i-1;
end; // howManySameChars

var
chosen: string;
Expand All @@ -5937,9 +5941,9 @@ procedure findSimilarIP(fromIP:string);
exit;
end;
chosen:=getIP();
a:=getIPs();
a:=getAcceptOptions();
for i:=0 to length(a)-1 do
if howManySameNumbers(chosen, fromIP) < howManySameNumbers(a[i], fromIP) then
if howManySameChars(chosen, fromIP) < howManySameChars(a[i], fromIP) then
chosen:=a[i];
setDefaultIP(chosen);
end; // findSimilarIP
Expand Down Expand Up @@ -7878,7 +7882,7 @@ procedure TmainFrm.timerEvent(Sender: TObject);
procedure every10sec();
var
s: string;
ss: Tstrings;
ss: TstringDynArray;
begin
if not stringExists(defaultIP, getPossibleAddresses()) then
// previous address not available anymore (it happens using dial-up)
Expand All @@ -7891,10 +7895,10 @@ procedure TmainFrm.timerEvent(Sender: TObject);
s:=getIP();
if not isLocalIP(s) then // clearly better
setDefaultIP(s)
else if ansiStartsStr('169', defaultIP) then // we consider the 169 worst of other locals
else if ansiStartsStr('169.', defaultIP) then // we consider the 169 worst of other locals
begin
ss:=LocalIPList();
if ss.count > 1 then
ss:=getAcceptOptions();
if length(ss) > 1 then
setDefaultIP(ss[ if_(ss[0]=defaultIP, 1, 0) ]);
end;;
end;
Expand Down Expand Up @@ -8209,25 +8213,24 @@ procedure Tmainfrm.refreshIPlist();
INDEX_FOR_NIC = 1;
var
a: TStringDynArray;
i: integer;
s: string;
begin
while IPaddress1.Items[INDEX_FOR_URL].Caption <> '-' do
IPaddress1.delete(INDEX_FOR_URL);
// fill 'IP address' menu
a:=getPossibleAddresses();
for i:=0 to length(a)-1 do
for s in a do
mainfrm.IPaddress1.Insert(INDEX_FOR_URL,
newItem(a[i], 0, a[i]=defaultIP, TRUE, ipmenuclick, 0, '') );
newItem(s, 0, s=defaultIP, TRUE, ipmenuclick, 0, '') );

// fill 'Accept connections on' menu
while Acceptconnectionson1.count > INDEX_FOR_NIC do
Acceptconnectionson1.delete(INDEX_FOR_NIC);
Anyaddress1.checked:= listenOn = '';
a:=listToArray(localIPlist);
addUniqueString('127.0.0.1', a);
for i:=0 to length(a)-1 do
a:=getAcceptOptions();
for s in a do
Acceptconnectionson1.Insert(INDEX_FOR_NIC,
newItem( a[i], 0, a[i]=listenOn, TRUE, acceptOnMenuclick, 0, '') );
newItem( s, 0, s=listenOn, TRUE, acceptOnMenuclick, 0, '') );
end; // refreshIPlist

procedure TmainFrm.filesBoxDblClick(Sender: TObject);
Expand Down Expand Up @@ -11361,7 +11364,7 @@ procedure TmainFrm.SelfTest1Click(Sender: TObject);
// we many need to try this specific test more than once
repeat
t:=now();
try result:=httpGet(SELF_TEST_URL+'?port='+port+'&host='+host+'&natted='+YESNO[localIPlist.IndexOf(externalIP)<0] )
try result:=httpGet(SELF_TEST_URL+'?port='+port+'&host='+host+'&natted='+YESNO[not stringExists(externalIP, getAcceptOptions())] )
except break end;
t:=now()-t;
if (result ='') or (result[1] <> '4') or progFrm.cancelRequested then break;
Expand Down
151 changes: 85 additions & 66 deletions utillib.pas
Original file line number Diff line number Diff line change
Expand Up @@ -82,11 +82,10 @@ function smartsize(size:int64):string;
function httpGet(url:string; from:int64=0; size:int64=-1):string;
function httpGetFile(url, filename:string; tryTimes:integer=1; notify:TdocDataEvent=NIL):boolean;
function httpFileSize(url:string):int64;
function getIPs():TStringDynArray;
function getPossibleAddresses():TstringDynArray;
function whatStatusPanel(statusbar:Tstatusbar; x:integer):integer;
function getExternalAddress(var res:string; provider:Pstring=NIL):boolean;
function checkAddressSyntax(address:string; wildcards:boolean=TRUE):boolean;
function checkAddressSyntax(address:string; mask:boolean=TRUE):boolean;
function inputQueryLong(const caption, msg:string; var value:string; ofs:integer=0):boolean;
procedure purgeVFSaccounts();
function exec(cmd:string; pars:string=''; showCmd:integer=SW_SHOW):boolean;
Expand Down Expand Up @@ -1378,56 +1377,72 @@ function filematch(mask, fn:string):boolean;
result:=result xor odd(invert);
end; // filematch

function checkAddressSyntax(address:string; wildcards:boolean=TRUE):boolean;
function checkAddressSyntax(address:string; mask:boolean=TRUE):boolean;
var
a1, a2: string;
i, dots, lastDot: integer;
wildcardsMet: boolean;

function validNumber():boolean;
begin result:=strToIntDef(substr(a1,lastDot+1,i-1), 0) <= 255 end;

sf: TSocketFamily;
begin
if not mask then
exit(WSocketIsIPEx(address, sf));
result:=FALSE;
if address = '' then exit;
while (address > '') and (address[1] = '\') do delete(address,1,1);
while (address > '') and (address[1] = '\') do
delete(address,1,1);
while address > '' do
begin
a2:=chop(';', address);
if sameText(a2, 'lan') then continue;
if sameText(a2, 'lan') then
continue;
a1:=chop('-', a2);
if a2 > '' then
if not checkAddressSyntax(a1, FALSE)
or not checkAddressSyntax(a2, FALSE) then
exit;
wildcardsMet:=FALSE;
dots:=0;
lastDot:=0;
for i:=1 to length(a1) do
case a1[i] of
'.':
begin
if not validNumber() then exit;
lastDot:=i;
inc(dots);
end;
'0'..'9': ;
'?','*' : if wildcards then wildcardsMet:=TRUE else exit;
else exit;
end;
if (dots > 3) or not wildcardsMet and (dots <> 3) then exit;
if reMatch(a1, '^[?*a-f0-9\.:]+$', '!') = 0 then
exit;
end;
result:=validNumber();
result:=TRUE;
end; // checkAddressSyntax

function ipv6hex(ip:TIcsIPv6Address):string;
begin
setLength(result, 4*8);
binToHex(@ip.words[0], pchar(result), sizeOf(ip))
end;

function addressMatch(mask, address:string):boolean;
var
invert: boolean;
part1, part2: string;
addrInt: dword;
ofs, i, bits: integer;
masks: TStringDynArray;
mode: (SINGLE, BITMASK, RANGE);
addr4: dword;
addr6: string;
bits: integer;
a: TStringDynArray;

function ipv6fix(s:string):string;
var
ok: boolean;
r: TIcsIPv6Address;
begin
if length(s) = 39 then
exit(replaceStr(s,':',''));
r:=wsocketStrToipv6(s, ok);
if ok then
exit(ipv6hex(r));
exit('');
end;

function ipv6range():boolean;
var
min, max: string;
begin
min:=ipv6fix(a[0]);
if min = ''then
exit(FALSE);
max:=ipv6fix(a[1]);
if max = '' then
exit(FALSE);
result:=(min <= addr6) and (max >= addr6)
end; // ipv6range

begin
result:=FALSE;
invert:=FALSE;
Expand All @@ -1436,39 +1451,45 @@ function addressMatch(mask, address:string):boolean;
delete(mask,1,1);
invert:=not invert;
end;
addrInt:=ipToInt(address);
masks:=split(';',mask);
ofs:=1;
while not result and (ofs <= length(mask)) do
addr6:=ipv6fix(address);
addr4:=0;
if addr6 = '' then
addr4:=ipToInt(address);
for mask in split(';',mask) do
begin
mode:=SINGLE;
part1:=trim(substr(mask, ofs, max(0,posEx(';', mask, ofs)-1) ));
inc(ofs, length(part1)+1);

if sameText(part1, 'lan') then
if result then
break;
if sameText(mask, 'lan') then
begin
result:=isLocalIP(address);
continue;
end;

i:=lastDelimiter('-/', part1);
if i > 0 then
// range?
a:=split('-', mask);
if length(a) = 2 then
begin
if part1[i] = '-' then mode:=RANGE
else mode:=BITMASK;
part2:=part1;
part1:=chop(i, 1, part2);
if addr6 > '' then
result:=ipv6range()
else
result:=(addr4 >= ipToInt(a[0])) and (addr4 <= ipToInt(a[1]));
continue;
end;

case mode of
SINGLE: result:=match( pchar(part1), pchar(address) ) > 0;
RANGE: result:=(addrInt >= ipToInt(part1)) and (addrInt <= ipToInt(part2));
BITMASK:
try
bits:=32-strToInt(part2);
result:=addrInt shr bits = ipToInt(part1) shr bits;
except end;
// bitmask? ipv4 only
a:=split('/', mask);
if (addr6='') and (length(a) = 2) then
begin
try
bits:=32-strToInt(a[1]);
result:=addr4 shr bits = ipToInt(a[0]) shr bits;
except
end;
continue;
end;

// single
result:=match( pchar(mask), pchar(address) ) > 0;
end;
result:=result xor invert;
end; // addressMatch
Expand Down Expand Up @@ -1757,10 +1778,12 @@ function getExternalAddress(var res:string; provider:Pstring=NIL):boolean;
if s = '' then exit;
// try to determine length
i:=1;
while (i < length(s)) and (i < 15) and charInSet(s[i+1], ['0'..'9','.']) do inc(i);
while (i > 0) and (s[i] = '.') do dec(i);
while (i < length(s)) and (i < 15) and charInSet(s[i+1], ['0'..'9','.']) do
inc(i);
while (i > 0) and (s[i] = '.') do
dec(i);
setLength(s,i);
result:= checkAddressSyntax(s) and not HSlib.isLocalIP(s);
result:= checkAddressSyntax(s, FALSE) and not HSlib.isLocalIP(s);
if not result then exit;
if (res <> s) and mainFrm.logOtherEventsChk.checked then
mainFrm.add2log('New external address: '+s+' via '+hostFromURL(addr));
Expand All @@ -1780,17 +1803,13 @@ function whatStatusPanel(statusbar:Tstatusbar; x:integer):integer;
end;
end; // whatStatusPanel

function getIPs():TStringDynArray;
begin
try result:=listToArray(localIPlist) except result:=NIL end;
end;

function getPossibleAddresses():TstringDynArray;
begin // next best
result:=toSA([defaultIP, dyndns.host]);
addArray(result, customIPs);
addString(externalIP, result);
addArray(result, getIPs());
try addArray(result, listToArray(localIPlist(sfAny)))
except end;
removeStrings('', result);
uniqueStrings(result);
end; // getPossibleAddresses
Expand Down

0 comments on commit 45f3896

Please sign in to comment.