From 27e903c56380abcb11b5a0b8d7ccab88a14b5cde Mon Sep 17 00:00:00 2001 From: beware Date: Mon, 21 Feb 2011 21:40:05 +0000 Subject: [PATCH 01/16] eliminated a lot of hints and warnings git-svn-id: file:///svnroot/lcore/trunk@94 b1de8a11-f9be-4011-bde0-cc7ace90066a --- bfifo.pas | 1 - binipstuff.pas | 7 ++++--- btime.pas | 21 +++++++++++---------- dnssync.pas | 8 +++----- dnswin.pas | 3 ++- lcore.pas | 16 +++++++++------- lcoreselect.pas | 3 +-- lsocket.pas | 29 ++++++++++++++++------------- 8 files changed, 46 insertions(+), 42 deletions(-) diff --git a/bfifo.pas b/bfifo.pas index 55cc24a..667c0da 100644 --- a/bfifo.pas +++ b/bfifo.pas @@ -76,7 +76,6 @@ end; function tfifo.get; var p:tlinklist; - a:integer; begin if len > size then len := size; if len <= 0 then begin diff --git a/binipstuff.pas b/binipstuff.pas index 1f5fed4..1cfa34d 100644 --- a/binipstuff.pas +++ b/binipstuff.pas @@ -4,6 +4,10 @@ ----------------------------------------------------------------------------- } unit binipstuff; +{$ifdef fpc} +{$mode delphi} +{$endif} + interface {$include lcoreconfig.inc} @@ -14,9 +18,6 @@ uses {$endif} pgtypes; -{$ifdef fpc} - {$mode delphi} -{$endif} {$ifdef cpu386}{$define i386}{$endif} {$ifdef i386}{$define ENDIAN_LITTLE}{$endif} diff --git a/btime.pas b/btime.pas index 62b957d..c130144 100644 --- a/btime.pas +++ b/btime.pas @@ -226,7 +226,7 @@ var f,g:float; o:tosversioninfo; isnt:boolean; - is9x:boolean; +{ is9x:boolean;} begin if (performancecountfreq = 0) then qpctimefloat; ticks_freq_known := false; @@ -239,7 +239,7 @@ begin o.dwOSVersionInfoSize := sizeof(o); getversionex(o); isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT; - is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS; +{ is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;} ticks_freq2 := f; mmtime_synchedqpc := false; @@ -327,14 +327,14 @@ const maxretries=5; margin=0.002; var - jump:float; - mm,f,qpc,newdrift,f1,f2:float; +{ jump:float;} + mm,f,qpc,newdrift:float; qpcjumped:boolean; - a,b,c:integer; - retrycount:integer; + a,b:integer; +{ retrycount:integer;} begin if not ticks_freq_known then measure_ticks_freq; - retrycount := maxretries; +{ retrycount := maxretries;} qpc := qpctimefloat; mm := mmtimefloat; @@ -351,7 +351,7 @@ begin mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc; mm := mmtimefloat; - dec(retrycount); + { dec(retrycount);} settc; result := qpctimefloat; f := mmtimefloat; @@ -382,6 +382,7 @@ begin { mmtime_drift := mmtime_drift + mmtime_driftavg[a];} end; { mmtime_drift := mmtime_drift / b;} + a := 5; if (b = 1) then a := 5 else if (b = 2) then a := 15 else if (b = 3) then a := 30 else if (b = 4) then a := 60 else if (b = 5) then a := 120 else if (b >= 5) then a := 120; mmtime_nextdriftcorrection := qpc + a; if (b >= 2) then warmup_finished := true; @@ -399,10 +400,10 @@ begin qpc := qpctimefloat; result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm; - f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm; + {f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm; jump := result-f; - {writeln('jump ',formatfloat('0.000000',jump),' drift ',formatfloat('0.00000000',mmtime_drift),' duration ',formatfloat('0.000',(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)),' ',formatfloat('0.00000000',jump/(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)));} + writeln('jump ',formatfloat('0.000000',jump),' drift ',formatfloat('0.00000000',mmtime_drift),' duration ',formatfloat('0.000',(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)),' ',formatfloat('0.00000000',jump/(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)));} f := result; end; diff --git a/dnssync.pas b/dnssync.pas index 7d6631c..c603b92 100644 --- a/dnssync.pas +++ b/dnssync.pas @@ -75,14 +75,14 @@ implementation {$i unixstuff.inc} + +{$ifdef syncdnscore} var numsockused:integer; fd:array[0..numsock-1] of integer; state:array[0..numsock-1] of tdnsstate; toaddr:array[0..numsock-1] of tbinip; -{$ifdef syncdnscore} - {$ifdef win32} const winsocket = 'wsock32.dll'; @@ -109,7 +109,6 @@ end; function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean; var - a:integer; addr : ansistring; port : ansistring; inaddr : TInetSockAddrV; @@ -177,7 +176,6 @@ var currenttime : integer; lag : ttimeval; - currenttimeout : ttimeval; selecttimeout : ttimeval; socknum:integer; needprocessing:array[0..numsock-1] of boolean; @@ -299,7 +297,7 @@ end; function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist; var dummy : integer; - a,b:integer; + a:integer; biniptemp:tbinip; l:tbiniplist; begin diff --git a/dnswin.pas b/dnswin.pas index 847f0fd..567ea68 100644 --- a/dnswin.pas +++ b/dnswin.pas @@ -21,7 +21,6 @@ type tdnswinasync=class(tthread) private freverse : boolean; - error : integer; freewhendone : boolean; hadevent : boolean; protected @@ -88,6 +87,7 @@ var hostent : phostent; addrlist:^pointer; begin + output := nil; if hints.ai_family <> af_inet6 then begin result := 0; @@ -264,6 +264,7 @@ begin if assigned (dwas.onrequestdone) then dwas.onrequestdone(dwas,awparam); dwas.hadevent := true; if dwas.freewhendone then dwas.free; + result := 0; {added returning 0 when handling --beware} end else begin //not passing unknown messages on to defwindowproc will cause window //creation to fail! --plugwash diff --git a/lcore.pas b/lcore.pas index 0f6eaef..1a2f93c 100755 --- a/lcore.pas +++ b/lcore.pas @@ -258,18 +258,20 @@ implementation {!!! added sleep call -beware} procedure sleep(i:integer); +{$ifdef win32} +begin + windows.sleep(i); +{$else} var tv:ttimeval; begin - {$ifdef win32} - windows.sleep(i); - {$else} - tv.tv_sec := i div 1000; - tv.tv_usec := (i mod 1000) * 1000; - select(0,nil,nil,nil,@tv); - {$endif} + tv.tv_sec := i div 1000; + tv.tv_usec := (i mod 1000) * 1000; + select(0,nil,nil,nil,@tv); +{$endif} end; + destructor tlcomponent.destroy; begin disconnecttasks(self); diff --git a/lcoreselect.pas b/lcoreselect.pas index 659bfce..38da6ba 100755 --- a/lcoreselect.pas +++ b/lcoreselect.pas @@ -64,7 +64,7 @@ type procedure processtimers;inline; var - tv ,tvnow : ttimeval ; + tvnow : ttimeval ; currenttimer : tltimer ; temptimer : tltimer ; @@ -90,7 +90,6 @@ end; procedure processasios(var fdsr,fdsw:fdset);//inline; var currentsocket : tlasio ; - tempsocket : tlasio ; socketcount : integer ; // for debugging perposes :) dw,bt:integer; currentfdword:fdword; diff --git a/lsocket.pas b/lsocket.pas index bcff643..642ec9a 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -134,6 +134,15 @@ type //this one has to be kept public for now because lcorewsaasyncselect calls it procedure connectionfailedhandler(error:word); + + {public in tlasio, and can't be private in both places, so should be public here. + fixes delphi warning --beware} + {$ifdef win32} + procedure myfdclose(fd : integer); override; + function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override; + function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override; + {$endif} + private {$ifdef ipv6} isv6socket : boolean; //identifies if the socket is v6, set by bindsocket @@ -142,11 +151,6 @@ type procedure connecttimeouthandler(sender:tobject); procedure connectsuccesshandler; - {$ifdef win32} - procedure myfdclose(fd : integer); override; - function myfdwrite(fd: LongInt;const buf;size: LongInt):LongInt; override; - function myfdread(fd: LongInt;var buf;size: LongInt):LongInt; override; - {$endif} end; tsocket=longint; // for compatibility with twsocket @@ -284,9 +288,6 @@ end; procedure tlsocket.connect; -var - a:integer; - ip:tbinip; begin if state <> wsclosed then close; //prevtime := 0; @@ -345,7 +346,6 @@ end; procedure tlsocket.bindsocket; var - a:integer; inAddrtemp:TInetSockAddrV; inAddrtempx:{$ifdef win32}winsock.TSockaddr{$else}TInetSockAddrV{$endif} absolute inaddrtemp; inaddrtempsize:integer; @@ -380,7 +380,9 @@ end; procedure tlsocket.listen; var + {$ifndef win32} yes,no:longint; + {$endif} socktype:integer; biniptemp:tbinip; origaddr:thostname; @@ -427,10 +429,11 @@ begin state := wsclosed; // then set this back as it was an undesired side effect of dup try - yes := $01010101; {Copied this from existing code. Value is empiric, - but works. (yes=true<>0) } - no := 0; {$ifndef win32} + yes := $01010101; {Copied this from existing code. Value is empiric, + but works. (yes=true<>0) } + no := 0; + if SetSocketOptions(fdhandlein, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes))=-1 then begin raise ESocketException.create('unable to set SO_REUSEADDR socket option'); end; @@ -552,7 +555,7 @@ begin if result > absoloutemaxs then begin myfdclose(result); a := result; - result := -1; +{ result := -1;} raise esocketexception.create('file discriptor out of range: '+inttostr(a)); end; end; -- 2.30.2 From 9eaeac69829469108bce954ccce0710bbdb27fb3 Mon Sep 17 00:00:00 2001 From: beware Date: Tue, 22 Feb 2011 05:40:41 +0000 Subject: [PATCH 02/16] added ipv6 detection on windows for built-in resolver git-svn-id: file:///svnroot/lcore/trunk@95 b1de8a11-f9be-4011-bde0-cc7ace90066a --- dnscore.pas | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/dnscore.pas b/dnscore.pas index d0dbbf0..7cbb828 100644 --- a/dnscore.pas +++ b/dnscore.pas @@ -221,7 +221,7 @@ implementation uses {$ifdef win32} - windows, + windows,winsock, {$endif} sysutils; @@ -781,9 +781,34 @@ begin end; {$else} + +{the following code's purpose is to determine what IP windows would come from, to reach an IP +it can be abused to find if there's any global v6 IPs, getaddrinfo seems unreliable (not working on XP atleast) +} +const + SIO_ROUTING_INTERFACE_QUERY = $c8000014; + function WSAIoctl(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; external 'ws2_32.dll' name 'WSAIoctl'; + +function getlocalipforip(const ip:tbinip):tbinip; +var + handle:integer; + a,b:integer; + inaddrv,inaddrv2:tinetsockaddrv; + srcx:winsock.tsockaddr absolute inaddrv2; +begin + makeinaddrv(ip,'0',inaddrv); + handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP); + if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0 + then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror)); + result := inaddrvtobinip(inaddrv2); + closesocket(handle); +end; + function getv6localips:tbiniplist; begin result := biniplist_new; + {this IP is chosen because it's the first normal global v6 IP that has no special purpose} + biniplist_add(result,getlocalipforip(ipstrtobinf('2001:200::'))); end; {$endif} -- 2.30.2 From 31d4361fb52761b6486f55af10268a51ee536a6f Mon Sep 17 00:00:00 2001 From: beware Date: Wed, 23 Feb 2011 06:46:34 +0000 Subject: [PATCH 03/16] added lcorelocalips: code to get local v4 and v6 IPs in a central place git-svn-id: file:///svnroot/lcore/trunk@96 b1de8a11-f9be-4011-bde0-cc7ace90066a --- dnscore.pas | 65 +------------- lcorelocalips.pas | 225 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 227 insertions(+), 63 deletions(-) create mode 100644 lcorelocalips.pas diff --git a/dnscore.pas b/dnscore.pas index 7cbb828..18e40c9 100644 --- a/dnscore.pas +++ b/dnscore.pas @@ -204,7 +204,6 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and {$ifdef ipv6} -function getv6localips:tbiniplist; procedure initpreferredmode; var @@ -221,9 +220,9 @@ implementation uses {$ifdef win32} - windows,winsock, + windows, {$endif} - + lcorelocalips, sysutils; @@ -750,68 +749,8 @@ begin end; - {$ifdef ipv6} -{$ifdef linux} -function getv6localips:tbiniplist; -var - t:textfile; - s,s2:ansistring; - ip:tbinip; - a:integer; -begin - result := biniplist_new; - - assignfile(t,'/proc/net/if_inet6'); - {$i-}reset(t);{$i+} - if ioresult <> 0 then exit; {none found, return empty list} - - while not eof(t) do begin - readln(t,s); - s2 := ''; - for a := 0 to 7 do begin - if (s2 <> '') then s2 := s2 + ':'; - s2 := s2 + copy(s,(a shl 2)+1,4); - end; - ipstrtobin(s2,ip); - if ip.family <> 0 then biniplist_add(result,ip); - end; - closefile(t); -end; - -{$else} - -{the following code's purpose is to determine what IP windows would come from, to reach an IP -it can be abused to find if there's any global v6 IPs, getaddrinfo seems unreliable (not working on XP atleast) -} -const - SIO_ROUTING_INTERFACE_QUERY = $c8000014; - function WSAIoctl(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; external 'ws2_32.dll' name 'WSAIoctl'; - -function getlocalipforip(const ip:tbinip):tbinip; -var - handle:integer; - a,b:integer; - inaddrv,inaddrv2:tinetsockaddrv; - srcx:winsock.tsockaddr absolute inaddrv2; -begin - makeinaddrv(ip,'0',inaddrv); - handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP); - if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0 - then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror)); - result := inaddrvtobinip(inaddrv2); - closesocket(handle); -end; - -function getv6localips:tbiniplist; -begin - result := biniplist_new; - {this IP is chosen because it's the first normal global v6 IP that has no special purpose} - biniplist_add(result,getlocalipforip(ipstrtobinf('2001:200::'))); -end; -{$endif} - procedure initpreferredmode; var l:tbiniplist; diff --git a/lcorelocalips.pas b/lcorelocalips.pas new file mode 100644 index 0000000..7e03c1b --- /dev/null +++ b/lcorelocalips.pas @@ -0,0 +1,225 @@ +{ Copyright (C) 2005 Bas Steendijk and Peter Green + For conditions of distribution and use, see copyright notice in zlib_license.txt + which is included in the package + ----------------------------------------------------------------------------- } + +{ +unit to get IP addresses assigned to local interfaces. +both IPv4 and IPv6, or one address family in isolation. +works on both windows and linux. + +notes: + +- localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in. + (typically, they're returned on linux and not on windows) + +- normal behavior is to return all v6 IPs, including link local (fe80::). + an app that doesn't want link local IPs has to filter them out. + windows XP returns only one, global scope, v6 IP, due to shortcomings. + +} + +unit lcorelocalips; + +interface + +uses binipstuff; + +{$include lcoreconfig.inc} + +function getlocalips:tbiniplist; +function getv4localips:tbiniplist; +{$ifdef ipv6} +function getv6localips:tbiniplist; +{$endif} + +implementation + +{$ifdef linux} + +uses + baseunix,sockets,sysutils; + +function getv6localips:tbiniplist; +var + t:textfile; + s,s2:ansistring; + ip:tbinip; + a:integer; +begin + result := biniplist_new; + + assignfile(t,'/proc/net/if_inet6'); + {$i-}reset(t);{$i+} + if ioresult <> 0 then exit; {none found, return empty list} + while not eof(t) do begin + readln(t,s); + s2 := ''; + for a := 0 to 7 do begin + if (s2 <> '') then s2 := s2 + ':'; + s2 := s2 + copy(s,(a shl 2)+1,4); + end; + ipstrtobin(s2,ip); + if ip.family <> 0 then biniplist_add(result,ip); + end; + closefile(t); +end; + +function getv4localips:tbiniplist; +const + IF_NAMESIZE=16; + SIOCGIFCONF=$8912; +type + tifconf=packed record + ifc_len:longint; + ifcu_rec:pointer; + end; + + tifrec=packed record + ifr_ifrn:array [0..IF_NAMESIZE-1] of char; + ifru_addr:TSockAddr; + end; + + tifrecarr=array[0..999] of tifrec; +var + s:integer; + ifc:tifconf; + ifr:^tifrecarr; + a:integer; + ip:tbinip; + ad:^TinetSockAddrV; +begin + result := biniplist_new; + + {must create a socket for this} + s := fpsocket(AF_INET,SOCK_DGRAM,0); + if (s < 0) then raise exception.create('getv4localips unable to create socket'); + + fillchar(ifc,sizeof(ifc),0); + + {get size of IP record list} + if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 1'); + + {allocate it, with extra room in case there's more interfaces added (as recommended)} + getmem(ifr,ifc.ifc_len shl 1); + ifc.ifcu_rec := ifr; + + {get IP record list} + if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 2'); + + fillchar(ad,sizeof(ad),0); + + for a := (ifc.ifc_len div sizeof (tifrec))-1 downto 0 do begin + ad := @ifr[a].ifru_addr; + ip := inaddrvtobinip(ad^); + biniplist_add(result,ip); + end; + + freemem(ifr); + FileClose(s); +end; + +function getlocalips:tbiniplist; +begin + result := getv4localips; + {$ifdef ipv6} + biniplist_addlist(result,getv6localips); + {$endif} +end; + +{$else} + +uses + sysutils,winsock,dnssync; + +{the following code's purpose is to determine what IP windows would come from, to reach an IP +it can be abused to find if there's any global v6 IPs on a local interface} +const + SIO_ROUTING_INTERFACE_QUERY = $c8000014; + function WSAIoctl(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; external 'ws2_32.dll' name 'WSAIoctl'; + +function getlocalipforip(const ip:tbinip):tbinip; +var + handle:integer; + a,b:integer; + inaddrv,inaddrv2:tinetsockaddrv; + srcx:winsock.tsockaddr absolute inaddrv2; +begin + makeinaddrv(ip,'0',inaddrv); + handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP); + if (handle < 0) then begin + {this happens on XP without an IPv6 stack + i can either fail with an exception, or with a "null result". an exception is annoying in the IDE} + {fillchar(result,sizeof(result),0); + exit; } + raise exception.create('getlocalipforip: can''t create socket'); + end; + if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0 + then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror)); + result := inaddrvtobinip(inaddrv2); + closesocket(handle); +end; + + +function getv4localips:tbiniplist; +var + templist:tbiniplist; + biniptemp:tbinip; + a:integer; +begin + result := biniplist_new; + + templist := getlocalips; + for a := biniplist_getcount(templist)-1 downto 0 do begin + biniptemp := biniplist_get(templist,a); + if biniptemp.family = AF_INET then biniplist_add(result,biniptemp); + end; +end; + +{$ifdef ipv6} +function getv6localips:tbiniplist; +var + templist:tbiniplist; + biniptemp:tbinip; + a:integer; +begin + result := biniplist_new; + + templist := getlocalips; + for a := biniplist_getcount(templist)-1 downto 0 do begin + biniptemp := biniplist_get(templist,a); + if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp); + end; +end; +{$endif} + +function getlocalips:tbiniplist; +var + a:integer; + ip:tbinip; +begin + result := forwardlookuplist('',0); + + {$ifdef ipv6} + + {windows XP doesn't add v6 IPs + if we find no v6 IPs in the list, add one using a hack} + for a := biniplist_getcount(result)-1 downto 0 do begin + ip := biniplist_get(result,a); + if ip.family = AF_INET6 then exit; + end; + + try + ip := getlocalipforip(ipstrtobinf('2001:200::')); + if (ip.family = AF_INET6) then biniplist_add(result,ip); + except + end; + {$endif} + +end; + +{$endif} + + + +end. -- 2.30.2 From eaa75975b23ce60360526c08628f2b0651c95167 Mon Sep 17 00:00:00 2001 From: beware Date: Thu, 24 Feb 2011 06:24:10 +0000 Subject: [PATCH 04/16] reorganization of system dns servers code git-svn-id: file:///svnroot/lcore/trunk@97 b1de8a11-f9be-4011-bde0-cc7ace90066a --- dnsasync.pas | 12 ++-- dnscore.pas | 156 ++++++++++++-------------------------------- dnssync.pas | 16 ++--- lcorelocalips.pas | 162 +++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 212 insertions(+), 134 deletions(-) diff --git a/dnsasync.pas b/dnsasync.pas index 4efc205..b6e8941 100644 --- a/dnsasync.pas +++ b/dnsasync.pas @@ -153,7 +153,7 @@ end; function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean; var - destination : ansistring; + destination : tbinip; inaddr : tinetsockaddrv; trytolisten:integer; begin @@ -185,11 +185,11 @@ begin end; if addr <> '' then begin dnsserverids[socketno] := -1; - destination := addr + destination := ipstrtobinf(addr); end else begin - destination := getcurrentsystemnameserver(dnsserverids[socketno]); + destination := getcurrentsystemnameserverbin(dnsserverids[socketno]); end; - destinations[socketno] := ipstrtobinf(destination); + destinations[socketno] := destination; {$ifdef ipv6}{$ifdef win32} if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6; @@ -255,8 +255,6 @@ begin exit; end; - if (overridednsserver <> '') and (addr = '') then addr := overridednsserver; - if overrideaf = useaf_default then begin {$ifdef ipv6} {$ifdef win32}if not (usewindns and (addr = '')) then{$endif} @@ -299,7 +297,6 @@ end; procedure tdnsasync.reverselookup; begin - if (overridednsserver <> '') and (addr = '') then addr := overridednsserver; {$ifdef win32} if usewindns and (addr = '') then begin dwas := tdnswinasync.create; @@ -316,7 +313,6 @@ end; procedure tdnsasync.customlookup; begin - if (overridednsserver <> '') and (addr = '') then addr := overridednsserver; setstate_custom(name,querytype,states[0]); numsockused := 1; asyncprocess(0); diff --git a/dnscore.pas b/dnscore.pas index 18e40c9..fa9eee2 100644 --- a/dnscore.pas +++ b/dnscore.pas @@ -188,7 +188,8 @@ procedure populatednsserverlist; procedure cleardnsservercache; var - dnsserverlist : tstringlist; + dnsserverlist : tbiniplist; + dnsserverlag:tlist; // currentdnsserverno : integer; @@ -196,6 +197,7 @@ var //id to the id of that nameserver. id should later be used to report how laggy //the servers response was and if it was timed out. function getcurrentsystemnameserver(var id:integer) :ansistring; +function getcurrentsystemnameserverbin(var id:integer) :tbinip; procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout //var @@ -219,9 +221,6 @@ function getquerytype(s:ansistring):integer; implementation uses - {$ifdef win32} - windows, - {$endif} lcorelocalips, sysutils; @@ -605,132 +604,59 @@ recursed: failure: setstate_failure(state); end; -{$ifdef win32} - const - MAX_HOSTNAME_LEN = 132; - MAX_DOMAIN_NAME_LEN = 132; - MAX_SCOPE_ID_LEN = 260 ; - MAX_ADAPTER_NAME_LENGTH = 260; - MAX_ADAPTER_ADDRESS_LENGTH = 8; - MAX_ADAPTER_DESCRIPTION_LENGTH = 132; - ERROR_BUFFER_OVERFLOW = 111; - MIB_IF_TYPE_ETHERNET = 6; - MIB_IF_TYPE_TOKENRING = 9; - MIB_IF_TYPE_FDDI = 15; - MIB_IF_TYPE_PPP = 23; - MIB_IF_TYPE_LOOPBACK = 24; - MIB_IF_TYPE_SLIP = 28; - - - type - tip_addr_string=packed record - Next :pointer; - IpAddress : array[0..15] of ansichar; - ipmask : array[0..15] of ansichar; - context : dword; - end; - pip_addr_string=^tip_addr_string; - tFIXED_INFO=packed record - HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar; - DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar; - currentdnsserver : pip_addr_string; - dnsserverlist : tip_addr_string; - nodetype : longint; - ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar; - enablerouting : longbool; - enableproxy : longbool; - enabledns : longbool; - end; - pFIXED_INFO=^tFIXED_INFO; - var - iphlpapi : thandle; - getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall; -{$endif} + procedure populatednsserverlist; var - {$ifdef win32} - fixed_info : pfixed_info; - fixed_info_len : longint; - currentdnsserver : pip_addr_string; - {$else} - t:textfile; - s:ansistring; - a:integer; - {$endif} + a:integer; begin - //result := ''; - if assigned(dnsserverlist) then begin - dnsserverlist.clear; + if assigned(dnsserverlag) then begin + dnsserverlag.clear; end else begin - dnsserverlist := tstringlist.Create; + dnsserverlag := tlist.Create; end; - {$ifdef win32} - if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll'); - if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams'); - if not assigned(getnetworkparams) then exit; - fixed_info_len := 0; - if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit; - //fixed_info_len :=sizeof(tfixed_info); - getmem(fixed_info,fixed_info_len); - if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin - freemem(fixed_info); - exit; - end; - currentdnsserver := @(fixed_info.dnsserverlist); - while assigned(currentdnsserver) do begin - dnsserverlist.Add(currentdnsserver.IpAddress); - currentdnsserver := currentdnsserver.next; - end; - freemem(fixed_info); - {$else} - filemode := 0; - assignfile(t,'/etc/resolv.conf'); - {$i-}reset(t);{$i+} - if ioresult <> 0 then exit; - - while not eof(t) do begin - readln(t,s); - if not (copy(s,1,10) = 'nameserver') then continue; - s := copy(s,11,500); - while s <> '' do begin - if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break; - end; - a := pos(' ',s); - if a <> 0 then s := copy(s,1,a-1); - a := pos(#9,s); - if a <> 0 then s := copy(s,1,a-1); - //result := s; - //if result <> '' then break; - dnsserverlist.Add(s); - end; - close(t); - {$endif} + + dnsserverlist := getsystemdnsservers; + for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil); end; procedure cleardnsservercache; begin - if assigned(dnsserverlist) then begin - dnsserverlist.destroy; - dnsserverlist := nil; + if assigned(dnsserverlag) then begin + dnsserverlag.destroy; + dnsserverlag := nil; + dnsserverlist := ''; end; end; -function getcurrentsystemnameserver(var id:integer):ansistring; +function getcurrentsystemnameserverbin(var id:integer):tbinip; var counter : integer; - begin - if not assigned(dnsserverlist) then populatednsserverlist; - if dnsserverlist.count=0 then raise exception.create('no dns servers availible'); - id := 0; - if dnsserverlist.count >1 then begin + {override the name server choice here, instead of overriding it whereever it's called + setting ID to -1 causes it to be ignored in reportlag} + if (overridednsserver <> '') then begin + result := ipstrtobinf(overridednsserver); + if result.family <> 0 then begin + id := -1; + exit; + end; + end; - for counter := 1 to dnsserverlist.count-1 do begin - if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter; + if not assigned(dnsserverlag) then populatednsserverlist; + if dnsserverlag.count=0 then raise exception.create('no dns servers availible'); + id := 0; + if dnsserverlag.count >1 then begin + for counter := dnsserverlag.count-1 downto 1 do begin + if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter; end; end; - result := dnsserverlist[id] + result := biniplist_get(dnsserverlist,id); +end; + +function getcurrentsystemnameserver(var id:integer):ansistring; +begin + result := ipbintostr(getcurrentsystemnameserverbin(id)); end; procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout @@ -738,12 +664,12 @@ var counter : integer; temp : integer; begin - if (id < 0) or (id >= dnsserverlist.count) then exit; + if (id < 0) or (id >= dnsserverlag.count) then exit; if lag = -1 then lag := timeoutlag; - for counter := 0 to dnsserverlist.count-1 do begin - temp := taddrint(dnsserverlist.objects[counter]) *15; + for counter := 0 to dnsserverlag.count-1 do begin + temp := taddrint(dnsserverlag[counter]) *15; if counter=id then temp := temp + lag; - dnsserverlist.objects[counter] := tobject(temp div 16); + dnsserverlag[counter] := tobject(temp div 16); end; end; diff --git a/dnssync.pas b/dnssync.pas index c603b92..1a506d5 100644 --- a/dnssync.pas +++ b/dnssync.pas @@ -109,7 +109,7 @@ end; function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean; var - addr : ansistring; + ip : tbinip; port : ansistring; inaddr : TInetSockAddrV; begin @@ -117,14 +117,14 @@ begin result := false; if len = 0 then exit; {no packet} - if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id); + ip := getcurrentsystemnameserverbin(id); {$ifdef ipv6}{$ifdef win32} if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6; {$endif}{$endif} port := toport; - toaddr[socknum] := ipstrtobinf(addr); + toaddr[socknum] := ip; makeinaddrv(toaddr[socknum],port,inaddr); sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr)); @@ -137,16 +137,14 @@ var inAddrtemp : TInetSockAddrV; a:integer; biniptemp:tbinip; - addr:ansistring; + begin //init both sockets smultaneously, always, so they get succesive fd's if fd[0] > 0 then exit; - if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id); + biniptemp := getcurrentsystemnameserverbin(id); //must get the DNS server here so we know to init v4 or v6 - ipstrtobin(addr,biniptemp); - if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0'); @@ -255,7 +253,7 @@ begin fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0); msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask); - if overridednsserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec); + reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec); SrcLen := SizeOf(Src); state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen); @@ -278,7 +276,7 @@ begin currenttime := getts; - if overridednsserver = '' then reportlag(id,-1); + reportlag(id,-1); if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin exit; end else begin diff --git a/lcorelocalips.pas b/lcorelocalips.pas index 7e03c1b..d20a04f 100644 --- a/lcorelocalips.pas +++ b/lcorelocalips.pas @@ -4,7 +4,10 @@ ----------------------------------------------------------------------------- } { -unit to get IP addresses assigned to local interfaces. +unit to get various local system config + + +- get IP addresses assigned to local interfaces. both IPv4 and IPv6, or one address family in isolation. works on both windows and linux. @@ -17,6 +20,12 @@ notes: an app that doesn't want link local IPs has to filter them out. windows XP returns only one, global scope, v6 IP, due to shortcomings. + + +- get system DNS servers + +- get system hostname + } unit lcorelocalips; @@ -33,6 +42,9 @@ function getv4localips:tbiniplist; function getv6localips:tbiniplist; {$endif} +function getsystemdnsservers:tbiniplist; +function getsystemhostname:ansistring; + implementation {$ifdef linux} @@ -130,7 +142,7 @@ end; {$else} uses - sysutils,winsock,dnssync; + sysutils,windows,winsock,dnssync; {the following code's purpose is to determine what IP windows would come from, to reach an IP it can be abused to find if there's any global v6 IPs on a local interface} @@ -222,4 +234,150 @@ end; + + +{$ifdef win32} + const + MAX_HOSTNAME_LEN = 132; + MAX_DOMAIN_NAME_LEN = 132; + MAX_SCOPE_ID_LEN = 260 ; + MAX_ADAPTER_NAME_LENGTH = 260; + MAX_ADAPTER_ADDRESS_LENGTH = 8; + MAX_ADAPTER_DESCRIPTION_LENGTH = 132; + ERROR_BUFFER_OVERFLOW = 111; + MIB_IF_TYPE_ETHERNET = 6; + MIB_IF_TYPE_TOKENRING = 9; + MIB_IF_TYPE_FDDI = 15; + MIB_IF_TYPE_PPP = 23; + MIB_IF_TYPE_LOOPBACK = 24; + MIB_IF_TYPE_SLIP = 28; + + + type + tip_addr_string=packed record + Next :pointer; + IpAddress : array[0..15] of ansichar; + ipmask : array[0..15] of ansichar; + context : dword; + end; + pip_addr_string=^tip_addr_string; + tFIXED_INFO=packed record + HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar; + DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar; + currentdnsserver : pip_addr_string; + dnsserverlist : tip_addr_string; + nodetype : longint; + ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar; + enablerouting : longbool; + enableproxy : longbool; + enabledns : longbool; + end; + pFIXED_INFO=^tFIXED_INFO; + + var + iphlpapi : thandle; + getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall; + +function callGetNetworkParams:pFIXED_INFO; +var + fixed_info : pfixed_info; + fixed_info_len : longint; +begin + result := nil; + if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll'); + if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams'); + if not assigned(getnetworkparams) then exit; + fixed_info_len := 0; + if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit; + //fixed_info_len :=sizeof(tfixed_info); + getmem(fixed_info,fixed_info_len); + if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin + freemem(fixed_info); + exit; + end; + result := fixed_info; +end; + +{$endif} + +function getsystemdnsservers:tbiniplist; +var + {$ifdef win32} + fixed_info : pfixed_info; + currentdnsserver : pip_addr_string; + {$else} + t:textfile; + s:ansistring; + a:integer; + {$endif} + ip:tbinip; +begin + //result := ''; + + result := biniplist_new; + + {$ifdef win32} + fixed_info := callgetnetworkparams; + if fixed_info = nil then exit; + + currentdnsserver := @(fixed_info.dnsserverlist); + while assigned(currentdnsserver) do begin + ip := ipstrtobinf(currentdnsserver.IpAddress); + if (ip.family <> 0) then biniplist_add(result,ip); + currentdnsserver := currentdnsserver.next; + end; + freemem(fixed_info); + {$else} + filemode := 0; + assignfile(t,'/etc/resolv.conf'); + {$i-}reset(t);{$i+} + if ioresult <> 0 then exit; + + while not eof(t) do begin + readln(t,s); + if not (copy(s,1,10) = 'nameserver') then continue; + s := copy(s,11,500); + while s <> '' do begin + if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break; + end; + a := pos(' ',s); + if a <> 0 then s := copy(s,1,a-1); + a := pos(#9,s); + if a <> 0 then s := copy(s,1,a-1); + + ip := ipstrtobinf(s); + if (ip.family <> 0) then biniplist_add(result,ip); + end; + closefile(t); + {$endif} +end; + + +function getsystemhostname:ansistring; +var + {$ifdef win32} + fixed_info : pfixed_info; + {$else} + t:textfile; + {$endif} +begin + result := ''; + {$ifdef win32} + fixed_info := callgetnetworkparams; + if fixed_info = nil then exit; + + result := fixed_info.hostname; + if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname; + + freemem(fixed_info); + {$else} + filemode := 0; + assignfile(t,'/etc/hostname'); + {$i-}reset(t);{$i+} + if ioresult <> 0 then exit; + readln(t,result); + closefile(t); + {$endif} +end; + end. -- 2.30.2 From 16fce740c1954b4d3e7eb7c2089dd94dc099bc26 Mon Sep 17 00:00:00 2001 From: beware Date: Fri, 25 Feb 2011 05:56:35 +0000 Subject: [PATCH 05/16] made getlocalips work on mac OS X (BSD) git-svn-id: file:///svnroot/lcore/trunk@98 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lcorelocalips.pas | 154 ++++++++++++++++++++++++++++------------------ 1 file changed, 94 insertions(+), 60 deletions(-) diff --git a/lcorelocalips.pas b/lcorelocalips.pas index d20a04f..76a410e 100644 --- a/lcorelocalips.pas +++ b/lcorelocalips.pas @@ -11,6 +11,13 @@ unit to get various local system config both IPv4 and IPv6, or one address family in isolation. works on both windows and linux. +tested on: + +- windows XP +- windows vista +- linux (2.6) +- mac OS X (probably works on freeBSD too) + notes: - localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in. @@ -24,7 +31,7 @@ notes: - get system DNS servers -- get system hostname +- get system hostname (if not on windows, use freepascal's "unix") } @@ -32,7 +39,7 @@ unit lcorelocalips; interface -uses binipstuff; +uses binipstuff,pgtypes; {$include lcoreconfig.inc} @@ -43,44 +50,27 @@ function getv6localips:tbiniplist; {$endif} function getsystemdnsservers:tbiniplist; -function getsystemhostname:ansistring; + +{$ifdef win32} +function gethostname:ansistring; +{$endif} implementation -{$ifdef linux} +{$ifdef unix} uses baseunix,sockets,sysutils; -function getv6localips:tbiniplist; -var - t:textfile; - s,s2:ansistring; - ip:tbinip; - a:integer; -begin - result := biniplist_new; - assignfile(t,'/proc/net/if_inet6'); - {$i-}reset(t);{$i+} - if ioresult <> 0 then exit; {none found, return empty list} - while not eof(t) do begin - readln(t,s); - s2 := ''; - for a := 0 to 7 do begin - if (s2 <> '') then s2 := s2 + ':'; - s2 := s2 + copy(s,(a shl 2)+1,4); - end; - ipstrtobin(s2,ip); - if ip.family <> 0 then biniplist_add(result,ip); - end; - closefile(t); -end; - -function getv4localips:tbiniplist; +function getlocalips_internal(wantfamily:integer):tbiniplist; const IF_NAMESIZE=16; - SIOCGIFCONF=$8912; + + {$ifdef linux}SIOCGIFCONF=$8912;{$endif} + {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif} + + {amd64: mac OS X: $C00C6924; freeBSD: $c0106924} type tifconf=packed record ifc_len:longint; @@ -92,12 +82,11 @@ type ifru_addr:TSockAddr; end; - tifrecarr=array[0..999] of tifrec; var s:integer; ifc:tifconf; - ifr:^tifrecarr; - a:integer; + ifr,ifr2,ifrmax:^tifrec; + lastlen,len:integer; ip:tbinip; ad:^TinetSockAddrV; begin @@ -109,28 +98,85 @@ begin fillchar(ifc,sizeof(ifc),0); - {get size of IP record list} - if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 1'); - {allocate it, with extra room in case there's more interfaces added (as recommended)} - getmem(ifr,ifc.ifc_len shl 1); - ifc.ifcu_rec := ifr; + ifr := nil; - {get IP record list} - if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 2'); - - fillchar(ad,sizeof(ad),0); + len := 2*sizeof(tifrec); + lastlen := 0; + repeat + reallocmem(ifr,len); + ifc.ifc_len := len; + ifc.ifcu_rec := ifr; + {get IP record list} + if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then begin + raise exception.create('getv4localips ioctl failed'); + end; + if (lastlen = ifc.ifc_len) then break; + lastlen := ifc.ifc_len; + len := len * 2; + until false; + + ifr2 := ifr; + ifrmax := pointer(taddrint(ifr) + ifc.ifc_len); + while (ifr2 < ifrmax) do begin + lastlen := taddrint(ifrmax) - taddrint(ifr2); + if (lastlen < sizeof(tifrec)) then break; {not enough left} + {calculate len} + ad := @ifr2.ifru_addr; + + {$ifdef bsd} + len := ad.inaddr.len + IF_NAMESIZE; + if (len < sizeof(tifrec)) then + {$endif} + len := sizeof(tifrec); + + if (len < sizeof(tifrec)) then break; {not enough left} - for a := (ifc.ifc_len div sizeof (tifrec))-1 downto 0 do begin - ad := @ifr[a].ifru_addr; ip := inaddrvtobinip(ad^); - biniplist_add(result,ip); + if (ip.family <> 0) and ((ip.family = wantfamily) or (wantfamily = 0)) then biniplist_add(result,ip); + inc(taddrint(ifr2),len); end; freemem(ifr); FileClose(s); end; +{$ifdef ipv6} +function getv6localips:tbiniplist; +var + t:textfile; + s,s2:ansistring; + ip:tbinip; + a:integer; +begin + result := biniplist_new; + + assignfile(t,'/proc/net/if_inet6'); + {$i-}reset(t);{$i+} + if ioresult <> 0 then begin + {not on linux, try if this OS uses the other way to return v6 addresses} + result := getlocalips_internal(AF_INET6); + exit; + end; + while not eof(t) do begin + readln(t,s); + s2 := ''; + for a := 0 to 7 do begin + if (s2 <> '') then s2 := s2 + ':'; + s2 := s2 + copy(s,(a shl 2)+1,4); + end; + ipstrtobin(s2,ip); + if ip.family <> 0 then biniplist_add(result,ip); + end; + closefile(t); +end; +{$endif} + +function getv4localips:tbiniplist; +begin + result := getlocalips_internal(AF_INET); +end; + function getlocalips:tbiniplist; begin result := getv4localips; @@ -352,17 +398,12 @@ begin {$endif} end; - -function getsystemhostname:ansistring; +{$ifdef win32} +function gethostname:ansistring; var - {$ifdef win32} fixed_info : pfixed_info; - {$else} - t:textfile; - {$endif} begin result := ''; - {$ifdef win32} fixed_info := callgetnetworkparams; if fixed_info = nil then exit; @@ -370,14 +411,7 @@ begin if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname; freemem(fixed_info); - {$else} - filemode := 0; - assignfile(t,'/etc/hostname'); - {$i-}reset(t);{$i+} - if ioresult <> 0 then exit; - readln(t,result); - closefile(t); - {$endif} end; +{$endif} end. -- 2.30.2 From a2d002aadb85c6411b55e3966247efb21eeff2b8 Mon Sep 17 00:00:00 2001 From: beware Date: Mon, 4 Apr 2011 14:58:41 +0000 Subject: [PATCH 06/16] increased maximum RR of a kind limit check git-svn-id: file:///svnroot/lcore/trunk@99 b1de8a11-f9be-4011-bde0-cc7ace90066a --- dnscore.pas | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/dnscore.pas b/dnscore.pas index fa9eee2..3a9596f 100644 --- a/dnscore.pas +++ b/dnscore.pas @@ -106,7 +106,10 @@ const querytype_txt=16; querytype_spf=99; maxrecursion=50; - maxrrofakind=20; + maxrrofakind=32; + {the maximum number of RR of a kind of purely an extra sanity check and could be omitted. + before, i set it to 20, but valid replies can have more. dnscore only does udp requests, + and ordinary DNS, so up to 512 bytes. the maximum number of A records that fits seems to be 29} retryafter=300000; //microseconds must be less than one second; timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds) @@ -502,7 +505,10 @@ begin state.numrr2 := 0; for a := 0 to 3 do begin state.numrr1[a] := htons(state.recvpacket.rrcount[a]); - if state.numrr1[a] > maxrrofakind then goto failure; + if state.numrr1[a] > maxrrofakind then begin + failurereason := 'exceeded maximum RR of a kind'; + goto failure; + end; inc(state.numrr2,state.numrr1[a]); end; -- 2.30.2 From 3ac664ec654230b9ad26ab12242c1db6f636a26f Mon Sep 17 00:00:00 2001 From: plugwash Date: Sun, 8 May 2011 00:01:47 +0000 Subject: [PATCH 07/16] fix line endings in lcorelocalips.pas git-svn-id: file:///svnroot/lcore/trunk@100 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lcorelocalips.pas | 834 +++++++++++++++++++++++----------------------- 1 file changed, 417 insertions(+), 417 deletions(-) diff --git a/lcorelocalips.pas b/lcorelocalips.pas index 76a410e..ae2a00b 100644 --- a/lcorelocalips.pas +++ b/lcorelocalips.pas @@ -1,417 +1,417 @@ -{ Copyright (C) 2005 Bas Steendijk and Peter Green - For conditions of distribution and use, see copyright notice in zlib_license.txt - which is included in the package - ----------------------------------------------------------------------------- } - -{ -unit to get various local system config - - -- get IP addresses assigned to local interfaces. -both IPv4 and IPv6, or one address family in isolation. -works on both windows and linux. - -tested on: - -- windows XP -- windows vista -- linux (2.6) -- mac OS X (probably works on freeBSD too) - -notes: - -- localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in. - (typically, they're returned on linux and not on windows) - -- normal behavior is to return all v6 IPs, including link local (fe80::). - an app that doesn't want link local IPs has to filter them out. - windows XP returns only one, global scope, v6 IP, due to shortcomings. - - - -- get system DNS servers - -- get system hostname (if not on windows, use freepascal's "unix") - -} - -unit lcorelocalips; - -interface - -uses binipstuff,pgtypes; - -{$include lcoreconfig.inc} - -function getlocalips:tbiniplist; -function getv4localips:tbiniplist; -{$ifdef ipv6} -function getv6localips:tbiniplist; -{$endif} - -function getsystemdnsservers:tbiniplist; - -{$ifdef win32} -function gethostname:ansistring; -{$endif} - -implementation - -{$ifdef unix} - -uses - baseunix,sockets,sysutils; - - -function getlocalips_internal(wantfamily:integer):tbiniplist; -const - IF_NAMESIZE=16; - - {$ifdef linux}SIOCGIFCONF=$8912;{$endif} - {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif} - - {amd64: mac OS X: $C00C6924; freeBSD: $c0106924} -type - tifconf=packed record - ifc_len:longint; - ifcu_rec:pointer; - end; - - tifrec=packed record - ifr_ifrn:array [0..IF_NAMESIZE-1] of char; - ifru_addr:TSockAddr; - end; - -var - s:integer; - ifc:tifconf; - ifr,ifr2,ifrmax:^tifrec; - lastlen,len:integer; - ip:tbinip; - ad:^TinetSockAddrV; -begin - result := biniplist_new; - - {must create a socket for this} - s := fpsocket(AF_INET,SOCK_DGRAM,0); - if (s < 0) then raise exception.create('getv4localips unable to create socket'); - - fillchar(ifc,sizeof(ifc),0); - - - ifr := nil; - - len := 2*sizeof(tifrec); - lastlen := 0; - repeat - reallocmem(ifr,len); - ifc.ifc_len := len; - ifc.ifcu_rec := ifr; - {get IP record list} - if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then begin - raise exception.create('getv4localips ioctl failed'); - end; - if (lastlen = ifc.ifc_len) then break; - lastlen := ifc.ifc_len; - len := len * 2; - until false; - - ifr2 := ifr; - ifrmax := pointer(taddrint(ifr) + ifc.ifc_len); - while (ifr2 < ifrmax) do begin - lastlen := taddrint(ifrmax) - taddrint(ifr2); - if (lastlen < sizeof(tifrec)) then break; {not enough left} - {calculate len} - ad := @ifr2.ifru_addr; - - {$ifdef bsd} - len := ad.inaddr.len + IF_NAMESIZE; - if (len < sizeof(tifrec)) then - {$endif} - len := sizeof(tifrec); - - if (len < sizeof(tifrec)) then break; {not enough left} - - ip := inaddrvtobinip(ad^); - if (ip.family <> 0) and ((ip.family = wantfamily) or (wantfamily = 0)) then biniplist_add(result,ip); - inc(taddrint(ifr2),len); - end; - - freemem(ifr); - FileClose(s); -end; - -{$ifdef ipv6} -function getv6localips:tbiniplist; -var - t:textfile; - s,s2:ansistring; - ip:tbinip; - a:integer; -begin - result := biniplist_new; - - assignfile(t,'/proc/net/if_inet6'); - {$i-}reset(t);{$i+} - if ioresult <> 0 then begin - {not on linux, try if this OS uses the other way to return v6 addresses} - result := getlocalips_internal(AF_INET6); - exit; - end; - while not eof(t) do begin - readln(t,s); - s2 := ''; - for a := 0 to 7 do begin - if (s2 <> '') then s2 := s2 + ':'; - s2 := s2 + copy(s,(a shl 2)+1,4); - end; - ipstrtobin(s2,ip); - if ip.family <> 0 then biniplist_add(result,ip); - end; - closefile(t); -end; -{$endif} - -function getv4localips:tbiniplist; -begin - result := getlocalips_internal(AF_INET); -end; - -function getlocalips:tbiniplist; -begin - result := getv4localips; - {$ifdef ipv6} - biniplist_addlist(result,getv6localips); - {$endif} -end; - -{$else} - -uses - sysutils,windows,winsock,dnssync; - -{the following code's purpose is to determine what IP windows would come from, to reach an IP -it can be abused to find if there's any global v6 IPs on a local interface} -const - SIO_ROUTING_INTERFACE_QUERY = $c8000014; - function WSAIoctl(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; external 'ws2_32.dll' name 'WSAIoctl'; - -function getlocalipforip(const ip:tbinip):tbinip; -var - handle:integer; - a,b:integer; - inaddrv,inaddrv2:tinetsockaddrv; - srcx:winsock.tsockaddr absolute inaddrv2; -begin - makeinaddrv(ip,'0',inaddrv); - handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP); - if (handle < 0) then begin - {this happens on XP without an IPv6 stack - i can either fail with an exception, or with a "null result". an exception is annoying in the IDE} - {fillchar(result,sizeof(result),0); - exit; } - raise exception.create('getlocalipforip: can''t create socket'); - end; - if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0 - then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror)); - result := inaddrvtobinip(inaddrv2); - closesocket(handle); -end; - - -function getv4localips:tbiniplist; -var - templist:tbiniplist; - biniptemp:tbinip; - a:integer; -begin - result := biniplist_new; - - templist := getlocalips; - for a := biniplist_getcount(templist)-1 downto 0 do begin - biniptemp := biniplist_get(templist,a); - if biniptemp.family = AF_INET then biniplist_add(result,biniptemp); - end; -end; - -{$ifdef ipv6} -function getv6localips:tbiniplist; -var - templist:tbiniplist; - biniptemp:tbinip; - a:integer; -begin - result := biniplist_new; - - templist := getlocalips; - for a := biniplist_getcount(templist)-1 downto 0 do begin - biniptemp := biniplist_get(templist,a); - if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp); - end; -end; -{$endif} - -function getlocalips:tbiniplist; -var - a:integer; - ip:tbinip; -begin - result := forwardlookuplist('',0); - - {$ifdef ipv6} - - {windows XP doesn't add v6 IPs - if we find no v6 IPs in the list, add one using a hack} - for a := biniplist_getcount(result)-1 downto 0 do begin - ip := biniplist_get(result,a); - if ip.family = AF_INET6 then exit; - end; - - try - ip := getlocalipforip(ipstrtobinf('2001:200::')); - if (ip.family = AF_INET6) then biniplist_add(result,ip); - except - end; - {$endif} - -end; - -{$endif} - - - - - -{$ifdef win32} - const - MAX_HOSTNAME_LEN = 132; - MAX_DOMAIN_NAME_LEN = 132; - MAX_SCOPE_ID_LEN = 260 ; - MAX_ADAPTER_NAME_LENGTH = 260; - MAX_ADAPTER_ADDRESS_LENGTH = 8; - MAX_ADAPTER_DESCRIPTION_LENGTH = 132; - ERROR_BUFFER_OVERFLOW = 111; - MIB_IF_TYPE_ETHERNET = 6; - MIB_IF_TYPE_TOKENRING = 9; - MIB_IF_TYPE_FDDI = 15; - MIB_IF_TYPE_PPP = 23; - MIB_IF_TYPE_LOOPBACK = 24; - MIB_IF_TYPE_SLIP = 28; - - - type - tip_addr_string=packed record - Next :pointer; - IpAddress : array[0..15] of ansichar; - ipmask : array[0..15] of ansichar; - context : dword; - end; - pip_addr_string=^tip_addr_string; - tFIXED_INFO=packed record - HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar; - DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar; - currentdnsserver : pip_addr_string; - dnsserverlist : tip_addr_string; - nodetype : longint; - ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar; - enablerouting : longbool; - enableproxy : longbool; - enabledns : longbool; - end; - pFIXED_INFO=^tFIXED_INFO; - - var - iphlpapi : thandle; - getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall; - -function callGetNetworkParams:pFIXED_INFO; -var - fixed_info : pfixed_info; - fixed_info_len : longint; -begin - result := nil; - if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll'); - if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams'); - if not assigned(getnetworkparams) then exit; - fixed_info_len := 0; - if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit; - //fixed_info_len :=sizeof(tfixed_info); - getmem(fixed_info,fixed_info_len); - if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin - freemem(fixed_info); - exit; - end; - result := fixed_info; -end; - -{$endif} - -function getsystemdnsservers:tbiniplist; -var - {$ifdef win32} - fixed_info : pfixed_info; - currentdnsserver : pip_addr_string; - {$else} - t:textfile; - s:ansistring; - a:integer; - {$endif} - ip:tbinip; -begin - //result := ''; - - result := biniplist_new; - - {$ifdef win32} - fixed_info := callgetnetworkparams; - if fixed_info = nil then exit; - - currentdnsserver := @(fixed_info.dnsserverlist); - while assigned(currentdnsserver) do begin - ip := ipstrtobinf(currentdnsserver.IpAddress); - if (ip.family <> 0) then biniplist_add(result,ip); - currentdnsserver := currentdnsserver.next; - end; - freemem(fixed_info); - {$else} - filemode := 0; - assignfile(t,'/etc/resolv.conf'); - {$i-}reset(t);{$i+} - if ioresult <> 0 then exit; - - while not eof(t) do begin - readln(t,s); - if not (copy(s,1,10) = 'nameserver') then continue; - s := copy(s,11,500); - while s <> '' do begin - if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break; - end; - a := pos(' ',s); - if a <> 0 then s := copy(s,1,a-1); - a := pos(#9,s); - if a <> 0 then s := copy(s,1,a-1); - - ip := ipstrtobinf(s); - if (ip.family <> 0) then biniplist_add(result,ip); - end; - closefile(t); - {$endif} -end; - -{$ifdef win32} -function gethostname:ansistring; -var - fixed_info : pfixed_info; -begin - result := ''; - fixed_info := callgetnetworkparams; - if fixed_info = nil then exit; - - result := fixed_info.hostname; - if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname; - - freemem(fixed_info); -end; -{$endif} - -end. +{ Copyright (C) 2005 Bas Steendijk and Peter Green + For conditions of distribution and use, see copyright notice in zlib_license.txt + which is included in the package + ----------------------------------------------------------------------------- } + +{ +unit to get various local system config + + +- get IP addresses assigned to local interfaces. +both IPv4 and IPv6, or one address family in isolation. +works on both windows and linux. + +tested on: + +- windows XP +- windows vista +- linux (2.6) +- mac OS X (probably works on freeBSD too) + +notes: + +- localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in. + (typically, they're returned on linux and not on windows) + +- normal behavior is to return all v6 IPs, including link local (fe80::). + an app that doesn't want link local IPs has to filter them out. + windows XP returns only one, global scope, v6 IP, due to shortcomings. + + + +- get system DNS servers + +- get system hostname (if not on windows, use freepascal's "unix") + +} + +unit lcorelocalips; + +interface + +uses binipstuff,pgtypes; + +{$include lcoreconfig.inc} + +function getlocalips:tbiniplist; +function getv4localips:tbiniplist; +{$ifdef ipv6} +function getv6localips:tbiniplist; +{$endif} + +function getsystemdnsservers:tbiniplist; + +{$ifdef win32} +function gethostname:ansistring; +{$endif} + +implementation + +{$ifdef unix} + +uses + baseunix,sockets,sysutils; + + +function getlocalips_internal(wantfamily:integer):tbiniplist; +const + IF_NAMESIZE=16; + + {$ifdef linux}SIOCGIFCONF=$8912;{$endif} + {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif} + + {amd64: mac OS X: $C00C6924; freeBSD: $c0106924} +type + tifconf=packed record + ifc_len:longint; + ifcu_rec:pointer; + end; + + tifrec=packed record + ifr_ifrn:array [0..IF_NAMESIZE-1] of char; + ifru_addr:TSockAddr; + end; + +var + s:integer; + ifc:tifconf; + ifr,ifr2,ifrmax:^tifrec; + lastlen,len:integer; + ip:tbinip; + ad:^TinetSockAddrV; +begin + result := biniplist_new; + + {must create a socket for this} + s := fpsocket(AF_INET,SOCK_DGRAM,0); + if (s < 0) then raise exception.create('getv4localips unable to create socket'); + + fillchar(ifc,sizeof(ifc),0); + + + ifr := nil; + + len := 2*sizeof(tifrec); + lastlen := 0; + repeat + reallocmem(ifr,len); + ifc.ifc_len := len; + ifc.ifcu_rec := ifr; + {get IP record list} + if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then begin + raise exception.create('getv4localips ioctl failed'); + end; + if (lastlen = ifc.ifc_len) then break; + lastlen := ifc.ifc_len; + len := len * 2; + until false; + + ifr2 := ifr; + ifrmax := pointer(taddrint(ifr) + ifc.ifc_len); + while (ifr2 < ifrmax) do begin + lastlen := taddrint(ifrmax) - taddrint(ifr2); + if (lastlen < sizeof(tifrec)) then break; {not enough left} + {calculate len} + ad := @ifr2.ifru_addr; + + {$ifdef bsd} + len := ad.inaddr.len + IF_NAMESIZE; + if (len < sizeof(tifrec)) then + {$endif} + len := sizeof(tifrec); + + if (len < sizeof(tifrec)) then break; {not enough left} + + ip := inaddrvtobinip(ad^); + if (ip.family <> 0) and ((ip.family = wantfamily) or (wantfamily = 0)) then biniplist_add(result,ip); + inc(taddrint(ifr2),len); + end; + + freemem(ifr); + FileClose(s); +end; + +{$ifdef ipv6} +function getv6localips:tbiniplist; +var + t:textfile; + s,s2:ansistring; + ip:tbinip; + a:integer; +begin + result := biniplist_new; + + assignfile(t,'/proc/net/if_inet6'); + {$i-}reset(t);{$i+} + if ioresult <> 0 then begin + {not on linux, try if this OS uses the other way to return v6 addresses} + result := getlocalips_internal(AF_INET6); + exit; + end; + while not eof(t) do begin + readln(t,s); + s2 := ''; + for a := 0 to 7 do begin + if (s2 <> '') then s2 := s2 + ':'; + s2 := s2 + copy(s,(a shl 2)+1,4); + end; + ipstrtobin(s2,ip); + if ip.family <> 0 then biniplist_add(result,ip); + end; + closefile(t); +end; +{$endif} + +function getv4localips:tbiniplist; +begin + result := getlocalips_internal(AF_INET); +end; + +function getlocalips:tbiniplist; +begin + result := getv4localips; + {$ifdef ipv6} + biniplist_addlist(result,getv6localips); + {$endif} +end; + +{$else} + +uses + sysutils,windows,winsock,dnssync; + +{the following code's purpose is to determine what IP windows would come from, to reach an IP +it can be abused to find if there's any global v6 IPs on a local interface} +const + SIO_ROUTING_INTERFACE_QUERY = $c8000014; + function WSAIoctl(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; external 'ws2_32.dll' name 'WSAIoctl'; + +function getlocalipforip(const ip:tbinip):tbinip; +var + handle:integer; + a,b:integer; + inaddrv,inaddrv2:tinetsockaddrv; + srcx:winsock.tsockaddr absolute inaddrv2; +begin + makeinaddrv(ip,'0',inaddrv); + handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP); + if (handle < 0) then begin + {this happens on XP without an IPv6 stack + i can either fail with an exception, or with a "null result". an exception is annoying in the IDE} + {fillchar(result,sizeof(result),0); + exit; } + raise exception.create('getlocalipforip: can''t create socket'); + end; + if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0 + then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror)); + result := inaddrvtobinip(inaddrv2); + closesocket(handle); +end; + + +function getv4localips:tbiniplist; +var + templist:tbiniplist; + biniptemp:tbinip; + a:integer; +begin + result := biniplist_new; + + templist := getlocalips; + for a := biniplist_getcount(templist)-1 downto 0 do begin + biniptemp := biniplist_get(templist,a); + if biniptemp.family = AF_INET then biniplist_add(result,biniptemp); + end; +end; + +{$ifdef ipv6} +function getv6localips:tbiniplist; +var + templist:tbiniplist; + biniptemp:tbinip; + a:integer; +begin + result := biniplist_new; + + templist := getlocalips; + for a := biniplist_getcount(templist)-1 downto 0 do begin + biniptemp := biniplist_get(templist,a); + if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp); + end; +end; +{$endif} + +function getlocalips:tbiniplist; +var + a:integer; + ip:tbinip; +begin + result := forwardlookuplist('',0); + + {$ifdef ipv6} + + {windows XP doesn't add v6 IPs + if we find no v6 IPs in the list, add one using a hack} + for a := biniplist_getcount(result)-1 downto 0 do begin + ip := biniplist_get(result,a); + if ip.family = AF_INET6 then exit; + end; + + try + ip := getlocalipforip(ipstrtobinf('2001:200::')); + if (ip.family = AF_INET6) then biniplist_add(result,ip); + except + end; + {$endif} + +end; + +{$endif} + + + + + +{$ifdef win32} + const + MAX_HOSTNAME_LEN = 132; + MAX_DOMAIN_NAME_LEN = 132; + MAX_SCOPE_ID_LEN = 260 ; + MAX_ADAPTER_NAME_LENGTH = 260; + MAX_ADAPTER_ADDRESS_LENGTH = 8; + MAX_ADAPTER_DESCRIPTION_LENGTH = 132; + ERROR_BUFFER_OVERFLOW = 111; + MIB_IF_TYPE_ETHERNET = 6; + MIB_IF_TYPE_TOKENRING = 9; + MIB_IF_TYPE_FDDI = 15; + MIB_IF_TYPE_PPP = 23; + MIB_IF_TYPE_LOOPBACK = 24; + MIB_IF_TYPE_SLIP = 28; + + + type + tip_addr_string=packed record + Next :pointer; + IpAddress : array[0..15] of ansichar; + ipmask : array[0..15] of ansichar; + context : dword; + end; + pip_addr_string=^tip_addr_string; + tFIXED_INFO=packed record + HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar; + DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar; + currentdnsserver : pip_addr_string; + dnsserverlist : tip_addr_string; + nodetype : longint; + ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar; + enablerouting : longbool; + enableproxy : longbool; + enabledns : longbool; + end; + pFIXED_INFO=^tFIXED_INFO; + + var + iphlpapi : thandle; + getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall; + +function callGetNetworkParams:pFIXED_INFO; +var + fixed_info : pfixed_info; + fixed_info_len : longint; +begin + result := nil; + if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll'); + if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams'); + if not assigned(getnetworkparams) then exit; + fixed_info_len := 0; + if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit; + //fixed_info_len :=sizeof(tfixed_info); + getmem(fixed_info,fixed_info_len); + if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin + freemem(fixed_info); + exit; + end; + result := fixed_info; +end; + +{$endif} + +function getsystemdnsservers:tbiniplist; +var + {$ifdef win32} + fixed_info : pfixed_info; + currentdnsserver : pip_addr_string; + {$else} + t:textfile; + s:ansistring; + a:integer; + {$endif} + ip:tbinip; +begin + //result := ''; + + result := biniplist_new; + + {$ifdef win32} + fixed_info := callgetnetworkparams; + if fixed_info = nil then exit; + + currentdnsserver := @(fixed_info.dnsserverlist); + while assigned(currentdnsserver) do begin + ip := ipstrtobinf(currentdnsserver.IpAddress); + if (ip.family <> 0) then biniplist_add(result,ip); + currentdnsserver := currentdnsserver.next; + end; + freemem(fixed_info); + {$else} + filemode := 0; + assignfile(t,'/etc/resolv.conf'); + {$i-}reset(t);{$i+} + if ioresult <> 0 then exit; + + while not eof(t) do begin + readln(t,s); + if not (copy(s,1,10) = 'nameserver') then continue; + s := copy(s,11,500); + while s <> '' do begin + if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break; + end; + a := pos(' ',s); + if a <> 0 then s := copy(s,1,a-1); + a := pos(#9,s); + if a <> 0 then s := copy(s,1,a-1); + + ip := ipstrtobinf(s); + if (ip.family <> 0) then biniplist_add(result,ip); + end; + closefile(t); + {$endif} +end; + +{$ifdef win32} +function gethostname:ansistring; +var + fixed_info : pfixed_info; +begin + result := ''; + fixed_info := callgetnetworkparams; + if fixed_info = nil then exit; + + result := fixed_info.hostname; + if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname; + + freemem(fixed_info); +end; +{$endif} + +end. -- 2.30.2 From e9fd84c2a9f04b8d9c1bc79d70c33c8d22d85e26 Mon Sep 17 00:00:00 2001 From: beware Date: Tue, 28 Jun 2011 18:09:07 +0000 Subject: [PATCH 08/16] fix execl to work git-svn-id: file:///svnroot/lcore/trunk@101 b1de8a11-f9be-4011-bde0-cc7ace90066a --- unixstuff.inc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unixstuff.inc b/unixstuff.inc index b522c74..dca63ce 100755 --- a/unixstuff.inc +++ b/unixstuff.inc @@ -47,7 +47,7 @@ var p : ppchar; begin - p := unixutil.StringToPPChar(Todo,1); + p := unixutil.StringToPPChar(Todo,0); if (p=nil) or (p^=nil) then exit; fpexecv(p^,p); end; @@ -168,4 +168,4 @@ {$endif} - \ No newline at end of file + -- 2.30.2 From 9e8179457b49de0ee52ab40192a88971fc3c01e6 Mon Sep 17 00:00:00 2001 From: plugwash Date: Fri, 19 Aug 2011 00:07:28 +0000 Subject: [PATCH 09/16] add O_NONBLOCK in lserial.pas, apparently some serial ports need this to open successfully and it's also consistent with how we open other stuff git-svn-id: file:///svnroot/lcore/trunk@102 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lserial.pas | 140 ++++++++++++++++++++++++++-------------------------- 1 file changed, 70 insertions(+), 70 deletions(-) diff --git a/lserial.pas b/lserial.pas index e7b6d27..cee4727 100755 --- a/lserial.pas +++ b/lserial.pas @@ -1,71 +1,71 @@ {$mode delphi} -unit lserial; -interface -uses - lcore; - -type - tlserial=class(tlasio) - public - device: string; - baudrate: longint; - procedure open; - end; - - -implementation -uses - baseunix, - unix, - unixutil, - termio, // despite the name the fpc termio unit seems to be an interface to termios - sysutils; -procedure tlserial.open; -var - fd : longint; - config : termios; - baudrateos : longint; -begin - fd := fpopen(device,O_RDWR or O_NOCTTY); - - if isatty(fd)=0 then begin - writeln('not a tty'); - halt(1); - end; - - fillchar(config,sizeof(config),#0); - config.c_cflag := CLOCAL or CREAD; - cfmakeraw(config); - case baudrate of - 50: baudrateos := B50; - 75: baudrateos := B75; - 110: baudrateos := B110; - 134: baudrateos := B134; - 150: baudrateos := B150; - 200: baudrateos := B200; - 300: baudrateos := B300; - 600: baudrateos := B600; - 1200: baudrateos := B1200; - 1800: baudrateos := B1800; - 2400: baudrateos := B2400; - 4800: baudrateos := B4800; - 9600: baudrateos := B9600; - 19200: baudrateos := B19200; - 38400: baudrateos := B38400; - 57600: baudrateos := B57600; - 115200: baudrateos := B115200; - 230400: baudrateos := B230400; - else raise exception.create('unrecognised baudrate'); - end; - cfsetispeed(config,baudrateos); - cfsetospeed(config,baudrateos); - config.c_cc[VMIN] := 1; - config.c_cc[VTIME] := 0; - if tcsetattr(fd,TCSAFLUSH,config) <0 then begin - writeln('could not set termios attributes'); - halt(3); - end; - dup(fd); - closehandles := true; -end; -end. \ No newline at end of file +unit lserial; +interface +uses + lcore; + +type + tlserial=class(tlasio) + public + device: string; + baudrate: longint; + procedure open; + end; + + +implementation +uses + baseunix, + unix, + unixutil, + termio, // despite the name the fpc termio unit seems to be an interface to termios + sysutils; +procedure tlserial.open; +var + fd : longint; + config : termios; + baudrateos : longint; +begin + fd := fpopen(device,O_RDWR or O_NOCTTY or O_NONBLOCK); + + if isatty(fd)=0 then begin + writeln('not a tty'); + halt(1); + end; + + fillchar(config,sizeof(config),#0); + config.c_cflag := CLOCAL or CREAD; + cfmakeraw(config); + case baudrate of + 50: baudrateos := B50; + 75: baudrateos := B75; + 110: baudrateos := B110; + 134: baudrateos := B134; + 150: baudrateos := B150; + 200: baudrateos := B200; + 300: baudrateos := B300; + 600: baudrateos := B600; + 1200: baudrateos := B1200; + 1800: baudrateos := B1800; + 2400: baudrateos := B2400; + 4800: baudrateos := B4800; + 9600: baudrateos := B9600; + 19200: baudrateos := B19200; + 38400: baudrateos := B38400; + 57600: baudrateos := B57600; + 115200: baudrateos := B115200; + 230400: baudrateos := B230400; + else raise exception.create('unrecognised baudrate'); + end; + cfsetispeed(config,baudrateos); + cfsetospeed(config,baudrateos); + config.c_cc[VMIN] := 1; + config.c_cc[VTIME] := 0; + if tcsetattr(fd,TCSAFLUSH,config) <0 then begin + writeln('could not set termios attributes'); + halt(3); + end; + dup(fd); + closehandles := true; +end; +end. -- 2.30.2 From e6290c8bee34fc9a6fdbce30a9dd85faffeaac5a Mon Sep 17 00:00:00 2001 From: beware Date: Tue, 11 Oct 2011 08:08:48 +0000 Subject: [PATCH 10/16] fixed listen breaking on kernel compiled without ipv6 git-svn-id: file:///svnroot/lcore/trunk@103 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lsocket.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/lsocket.pas b/lsocket.pas index 642ec9a..72ef891 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -419,6 +419,7 @@ begin if (addr = '::') and (origaddr = '') and (fdhandlein < 0) then begin {writeln('failed to create an IPV6 socket with error ',socketerror,'. trying to create an IPV4 one instead');} addr := '0.0.0.0'; + biniptemp := ipstrtobinf(addr); fdhandlein := socket(PF_INET,socktype,0); end; {$endif} -- 2.30.2 From 94bbdfffcfac987de199779e92ac317393bb21d4 Mon Sep 17 00:00:00 2001 From: plugwash Date: Sun, 6 Nov 2011 22:45:21 +0000 Subject: [PATCH 11/16] use rm -f in clean target git-svn-id: file:///svnroot/lcore/trunk@104 b1de8a11-f9be-4011-bde0-cc7ace90066a --- Makefile | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 2d70069..604864d 100755 --- a/Makefile +++ b/Makefile @@ -7,11 +7,11 @@ lcoretest: *.pas *.inc lcoretest.dpr fpc -Sd -gl -dipv6 lcoretest.dpr clean: - -rm *.o - -rm *.ppu - -rm *.exe - -rm *.dcu - -rm lcoretest + -rm -f *.o + -rm -f *.ppu + -rm -f *.exe + -rm -f *.dcu + -rm -f lcoretest date := $(shell date +%Y%m%d) -- 2.30.2 From fb5326037eba3c03fc24b645811e2e460365e8b9 Mon Sep 17 00:00:00 2001 From: beware Date: Fri, 18 Nov 2011 23:20:51 +0000 Subject: [PATCH 12/16] fix destroysourcestream always false bug git-svn-id: file:///svnroot/lcore/trunk@105 b1de8a11-f9be-4011-bde0-cc7ace90066a --- readtxt2.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/readtxt2.pas b/readtxt2.pas index a5f7de4..ee65736 100644 --- a/readtxt2.pas +++ b/readtxt2.pas @@ -56,7 +56,6 @@ begin if sourcestream.Position >= sourcestream.size then fileeof := true; bufpointer := bufsize; - destroysourcestream := false; end; constructor treadtxt.createf(filename: string); -- 2.30.2 From 12873c59bfaeb05331a96c3611843aceedc899e0 Mon Sep 17 00:00:00 2001 From: beware Date: Wed, 23 Nov 2011 00:04:55 +0000 Subject: [PATCH 13/16] fixed missing semicolon if compiling without ipv6 git-svn-id: file:///svnroot/lcore/trunk@106 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lsocket.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lsocket.pas b/lsocket.pas index 72ef891..573644b 100755 --- a/lsocket.pas +++ b/lsocket.pas @@ -587,7 +587,7 @@ begin destx := {$ifdef win32}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest) end; {$else} - destx := {$ifdef win32}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest) + destx := {$ifdef win32}winsock.pSockAddr{$else}pInetSockAddrV{$endif}(@dest); {$endif} result := {$ifdef win32}winsock.sendto{$else}system_sendto{$endif}(self.fdhandleout,data^,len,0,destx^,destlen); -- 2.30.2 From 693e2ce95d2225be709499570ea94c324d663562 Mon Sep 17 00:00:00 2001 From: beware Date: Fri, 25 Nov 2011 04:36:29 +0000 Subject: [PATCH 14/16] some consolidation git-svn-id: file:///svnroot/lcore/trunk@107 b1de8a11-f9be-4011-bde0-cc7ace90066a --- binipstuff.pas | 4 ++-- pgtypes.inc | 3 +++ pgtypes.pas | 10 +++++++++- 3 files changed, 14 insertions(+), 3 deletions(-) create mode 100644 pgtypes.inc diff --git a/binipstuff.pas b/binipstuff.pas index 1cfa34d..0b9fcb8 100644 --- a/binipstuff.pas +++ b/binipstuff.pas @@ -18,8 +18,8 @@ uses {$endif} pgtypes; -{$ifdef cpu386}{$define i386}{$endif} -{$ifdef i386}{$define ENDIAN_LITTLE}{$endif} + +{$include pgtypes.inc} {$include uint32.inc} diff --git a/pgtypes.inc b/pgtypes.inc new file mode 100644 index 0000000..af3381e --- /dev/null +++ b/pgtypes.inc @@ -0,0 +1,3 @@ +{$ifdef cpu386}{$define i386}{$endif} +{$ifdef i386}{$define ENDIAN_LITTLE}{$endif} + diff --git a/pgtypes.pas b/pgtypes.pas index d42a6b2..3c13976 100755 --- a/pgtypes.pas +++ b/pgtypes.pas @@ -7,8 +7,10 @@ unit pgtypes; interface + +{$include pgtypes.inc} + type - {$ifdef cpu386}{$define i386}{$endif} {$ifdef i386} taddrint=longint; {$else} @@ -20,6 +22,12 @@ interface thostname = ansistring; { string type for storing data (bytes) } tbufferstring = ansistring; + + {another name for a string with bytes, not implying it's to be used for a buffer} + bytestring = tbufferstring; + + {a char that is always one byte} + bytechar = ansichar; implementation end. -- 2.30.2 From 9653ddc572f5fd8ec065e4c357101ae6edae7959 Mon Sep 17 00:00:00 2001 From: beware Date: Fri, 9 Dec 2011 23:15:45 +0000 Subject: [PATCH 15/16] fix dnscore based resolving failure on windows git-svn-id: file:///svnroot/lcore/trunk@108 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lcorelocalips.pas | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lcorelocalips.pas b/lcorelocalips.pas index ae2a00b..dcc633a 100644 --- a/lcorelocalips.pas +++ b/lcorelocalips.pas @@ -188,7 +188,7 @@ end; {$else} uses - sysutils,windows,winsock,dnssync; + sysutils,windows,winsock,dnssync,dnscore; {the following code's purpose is to determine what IP windows would come from, to reach an IP it can be abused to find if there's any global v6 IPs on a local interface} @@ -255,8 +255,14 @@ function getlocalips:tbiniplist; var a:integer; ip:tbinip; + usewindnstemp:boolean; begin + {this lookup must always be done with the windows API lookup + setting usewindns to false on windows will fail with infinite recursion} + usewindnstemp := usewindns; + usewindns := true; result := forwardlookuplist('',0); + usewindns := usewindnstemp; {$ifdef ipv6} -- 2.30.2 From 250fdcdbf77f0296f31391eb3a8b87de195aad92 Mon Sep 17 00:00:00 2001 From: beware Date: Sat, 10 Dec 2011 13:29:58 +0000 Subject: [PATCH 16/16] redone getlocalips fix more neatly git-svn-id: file:///svnroot/lcore/trunk@109 b1de8a11-f9be-4011-bde0-cc7ace90066a --- lcorelocalips.pas | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/lcorelocalips.pas b/lcorelocalips.pas index dcc633a..aafddf7 100644 --- a/lcorelocalips.pas +++ b/lcorelocalips.pas @@ -188,7 +188,7 @@ end; {$else} uses - sysutils,windows,winsock,dnssync,dnscore; + sysutils,windows,winsock,dnswin; {the following code's purpose is to determine what IP windows would come from, to reach an IP it can be abused to find if there's any global v6 IPs on a local interface} @@ -256,13 +256,9 @@ var a:integer; ip:tbinip; usewindnstemp:boolean; + error:integer; begin - {this lookup must always be done with the windows API lookup - setting usewindns to false on windows will fail with infinite recursion} - usewindnstemp := usewindns; - usewindns := true; - result := forwardlookuplist('',0); - usewindns := usewindnstemp; + result := winforwardlookuplist('',0,error); {$ifdef ipv6} -- 2.30.2