better ipv6 support

hslib.pas

@@ -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))
@@ -670,6 +672,7 @@ try
     P_port:=sock.getxport();
   result:=TRUE;
 
+  if onAddress = '*' then
     try
       sock.MultiListenSockets.Clear();
       with sock.MultiListenSockets.Add do

main.pas

@@ -4256,6 +4256,13 @@ while i < srv.conns.count do
   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);
@@ -4273,7 +4280,7 @@ begin
 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
@@ -5911,19 +5918,16 @@ end; // httpEvent
 
 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;
+  i:=1;
-  while ip1 > '' do
+  n:=min(length(ip1),length(ip2));
-    begin
+  while (i<=n) and (ip1[i] = ip2[i]) do
-    n1:=chop('.',ip1);
+    inc(i);
-    n2:=chop('.',ip2);
+  result:=i-1;
-    if n1 <> n2 then exit;
+  end; // howManySameChars
-    inc(result);
-    end;
-  end; // howManySameNumbers
 
 var
   chosen: string;
@@ -5937,9 +5941,9 @@ if stringExists(fromIP, customIPs) then
   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
@@ -7878,7 +7882,7 @@ var
   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)
@@ -7891,10 +7895,10 @@ var
     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();
+      ss:=getAcceptOptions();
-      if ss.count > 1 then
+      if length(ss) > 1 then
         setDefaultIP(ss[ if_(ss[0]=defaultIP, 1, 0) ]);
       end;;
     end;
@@ -8209,25 +8213,24 @@ CONST
   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);
+a:=getAcceptOptions();
-addUniqueString('127.0.0.1', a);
+for s in a do
-for i:=0 to length(a)-1 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);
@@ -11361,7 +11364,7 @@ resourcestring
   // 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;

utillib.pas

@@ -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;
@@ -1378,56 +1377,72 @@ while mask > '' do
 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;
+  sf: TSocketFamily;
-  wildcardsMet: boolean;
-
-  function validNumber():boolean;
-  begin result:=strToIntDef(substr(a1,lastDot+1,i-1), 0) <= 255 end;
-
 begin
+if not mask then
+  exit(WSocketIsIPEx(address, sf));
 result:=FALSE;
-if address = '' then exit;
+while (address > '') and (address[1] = '\') do
-while (address > '') and (address[1] = '\') do delete(address,1,1);
+  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;
+  if reMatch(a1, '^[?*a-f0-9\.:]+$', '!') = 0 then
-  dots:=0;
+    exit;
-  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': ;
+result:=TRUE;
-      '?','*' : if wildcards then wildcardsMet:=TRUE else exit;
-      else exit;
-      end;
-  if (dots > 3) or not wildcardsMet and (dots <> 3) then exit;
-  end;
-result:=validNumber();
 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;
+  addr4: dword;
-  addrInt: dword;
+  addr6: string;
-  ofs, i, bits: integer;
+  bits: integer;
-  masks: TStringDynArray;
+  a: TStringDynArray;
-  mode: (SINGLE, BITMASK, RANGE);
+
+  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;
@@ -1436,39 +1451,45 @@ while (mask > '') and (mask[1] = '\') do
   delete(mask,1,1);
   invert:=not invert;
   end;
-addrInt:=ipToInt(address);
+addr6:=ipv6fix(address);
-masks:=split(';',mask);
+addr4:=0;
-ofs:=1;
+if addr6 = '' then
-while not result and (ofs <= length(mask)) do
+  addr4:=ipToInt(address);
+for mask in split(';',mask) do
   begin
-  mode:=SINGLE;
+  if result then
-  part1:=trim(substr(mask, ofs, max(0,posEx(';', mask, ofs)-1) ));
+    break;
-  inc(ofs, length(part1)+1);
+  if sameText(mask, 'lan') then
-
-  if sameText(part1, 'lan') then
     begin
     result:=isLocalIP(address);
     continue;
     end;
 
-  i:=lastDelimiter('-/', part1);
+  // range?
-  if i > 0 then
+  a:=split('-', mask);
+  if length(a) = 2 then
     begin
-    if part1[i] = '-' then mode:=RANGE
+    if addr6 > '' then
-    else mode:=BITMASK;
+      result:=ipv6range()
-    part2:=part1;
+    else
-    part1:=chop(i, 1, part2);
+      result:=(addr4 >= ipToInt(a[0])) and (addr4 <= ipToInt(a[1]));
+    continue;
     end;
 
-  case mode of
+  // bitmask? ipv4 only
-    SINGLE: result:=match( pchar(part1), pchar(address) ) > 0;
+  a:=split('/', mask);
-    RANGE: result:=(addrInt >= ipToInt(part1)) and (addrInt <= ipToInt(part2));
+  if (addr6='') and (length(a) = 2) then
-    BITMASK:
+    begin
     try
-        bits:=32-strToInt(part2);
+      bits:=32-strToInt(a[1]);
-        result:=addrInt shr bits = ipToInt(part1) shr bits;
+      result:=addr4 shr bits = ipToInt(a[0]) shr bits;
-      except end;
+    except
       end;
+    continue;
+    end;
+
+  // single
+  result:=match( pchar(mask), pchar(address) ) > 0;
   end;
 result:=result xor invert;
 end; // addressMatch
@@ -1757,10 +1778,12 @@ s:=trim(s);
 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 < length(s)) and (i < 15) and charInSet(s[i+1], ['0'..'9','.']) do
-while (i > 0) and (s[i] = '.') do dec(i);
+  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));
@@ -1780,17 +1803,13 @@ while (x > x1) and (result < statusbar.Panels.Count-1) do
   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