+type\r
+ pbiniplist=^tbiniplist;\r
+ thostsfile_entry=record\r
+ l:tbiniplist;\r
+ end;\r
+ phostsfile_entry=^thostsfile_entry;\r
+\r
+ thostsfile_reverseentry=record\r
+ name:ansistring;\r
+ end;\r
+ phostsfile_reverseentry=^thostsfile_reverseentry;\r
+\r
+\r
+function hostsfile_findbyname(const name:ansistring):integer;\r
+begin\r
+ if not hostsfile_entries.Find(name,result) then begin\r
+ if (copy(name,length(name),1) = '.') then begin\r
+ //if the name has a trailing dot, try to find without it\r
+ if not hostsfile_entries.Find(copy(name,1,length(name)-1),result) then result := -1;\r
+ end else begin\r
+ //if the name has no trailing dot, try to find with it\r
+ if not hostsfile_entries.Find(name + '.',result) then result := -1;\r
+ end;\r
+ end;\r
+end;\r
+\r
+\r
+function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist;\r
+var\r
+ index:integer;\r
+ l:tbiniplist;\r
+begin\r
+ hostsfile_init;\r
+ index := hostsfile_findbyname(name);\r
+\r
+ result := biniplist_new;\r
+\r
+ if (index >= 0) then begin\r
+ l := phostsfile_entry(hostsfile_entries.objects[index]).l;\r
+\r
+ {$ifdef ipv6}\r
+ if (useaf <> useaf_v6) and (useaf <> useaf_preferv6) then\r
+ {$endif}\r
+ begin\r
+ addipsoffamily(result,l,af_inet);\r
+ end;\r
+ {$ifdef ipv6}\r
+ if (useaf <> useaf_v4) then begin\r
+ addipsoffamily(result,l,af_inet6);\r
+ if (useaf = useaf_preferv6) then begin\r
+ addipsoffamily(result,l,af_inet);\r
+ end;\r
+ end;\r
+ {$endif}\r
+ end;\r
+end;\r
+\r
+procedure hostsfile_clearreverse;\r
+var\r
+ index:integer;\r
+begin\r
+ for index := hostsfile_reverseentries.count-1 downto 0 do begin\r
+ phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name := '';\r
+ dispose(phostsfile_reverseentry(hostsfile_reverseentries.objects[index]));\r
+ end;\r
+ hostsfile_reverseentries.clear;\r
+end;\r
+\r
+\r
+procedure hostsfile_initreverse;\r
+var\r
+ index,index2:integer;\r
+ l:tbiniplist;\r
+ a,countbefore:integer;\r
+ ip:tbinip;\r
+ s:ansistring;\r
+ he:phostsfile_reverseentry;\r
+begin\r
+ hostsfile_init;\r
+ if hostsfile_reverseinited then exit;\r
+ hostsfile_reverseinited := true;\r
+\r
+ hostsfile_clearreverse;\r
+\r
+ //build fast search table for reverse lookups\r
+ for index := hostsfile_entries.count-1 downto 0 do begin\r
+ l := phostsfile_entry(hostsfile_entries.objects[index]).l;\r
+ for a := biniplist_getcount(l)-1 downto 0 do begin\r
+ ip := biniplist_get(l,a);\r
+ s := ipbintostr(ip);\r
+\r
+ countbefore := hostsfile_reverseentries.count;\r
+ index2 := hostsfile_reverseentries.Add(s);\r
+ if (hostsfile_reverseentries.count > countbefore) then begin\r
+ new(he);\r
+ hostsfile_reverseentries.objects[index2] := tobject(he);\r
+ he.name := hostsfile_entries[index];\r
+ end;\r
+\r
+ end;\r
+ end;\r
+end;\r
+\r
+function hostsfile_reverselookup(ip:tbinip):ansistring;\r
+var\r
+ index:integer;\r
+ s:ansistring;\r
+begin\r
+ hostsfile_initreverse;\r
+ result := '';\r
+ s := ipbintostr(ip);\r
+\r
+ if hostsfile_reverseentries.find(s,index) then begin\r
+ result := phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name;\r
+ end;\r
+end;\r
+\r
+procedure hostsfile_clear;\r
+var\r
+ index:integer;\r
+begin\r
+ for index := hostsfile_entries.count-1 downto 0 do begin\r
+ biniplist_free(phostsfile_entry(hostsfile_entries.objects[index]).l);\r
+ dispose(phostsfile_entry(hostsfile_entries.objects[index]));\r
+ end;\r
+ hostsfile_entries.clear;\r
+\r
+ hostsfile_clearreverse;\r
+\r
+ hostsfile_lastfileage := 0;\r
+ hostsfile_lastcheckts := 0;\r
+end;\r
+\r
+procedure hostsfile_add(const name:ansistring;const ip:tbinip);\r
+var\r
+\r
+ a,index,countbefore:integer;\r
+\r
+ ip2:tbinip;\r
+ he:phostsfile_entry;\r
+ l:tbiniplist;\r
+begin\r
+\r
+ countbefore := hostsfile_entries.count;\r
+ //add, with dupignore, will add it if it's not in the list. if it is in the list, it returns the index\r
+ //to know if it was added, see if the count went up. this saves on duplicate searches in the list, for speed\r
+ index := hostsfile_entries.add(name);\r
+\r
+ if (hostsfile_entries.count > countbefore) then begin\r
+ // writeln('name newly added ',name,' ',ipbintostr(ip),' ',index);\r
+\r
+ new(he);\r
+ hostsfile_entries.objects[index] := tobject(he);\r
+ he.l := biniplist_new;\r
+ //he.name := name;\r
+ end else begin\r
+ // writeln('name found ',name,' ',ipbintostr(ip),' ',index);\r
+ //search for IP match\r
+\r
+ he := phostsfile_entry(hostsfile_entries.objects[index]);\r
+ l := he.l;\r
+ for a := biniplist_getcount(l)-1 downto 0 do begin\r
+ ip2 := biniplist_get(l,a);\r
+ if comparebinip(ip,ip2) then begin\r
+ // writeln('duplicate ip ',name,' ',ipbintostr(ip));\r
+ exit; //duplicate\r
+ end;\r
+ end;\r
+ end;\r
+ //add it\r
+ biniplist_add(he.l,ip);\r
+end;\r
+\r
+\r
+function getts:integer;\r
+{$ifdef mswindows}\r
+begin\r
+ result := GetTickCount;\r
+{$else}\r
+var\r
+ temp:ttimeval;\r
+begin\r
+ gettimemonotonic(temp);\r
+ result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000));\r
+{$endif}\r
+end;\r
+\r
+\r
+function gethostsfilename:ansistring;\r
+var\r
+{$ifdef mswindows}\r
+ windir:array [0..255] of ansichar;\r
+\r
+ GetSystemWindowsDirectoryA:function(buffer:pansichar;size:integer):integer; stdcall;\r
+ dllhandle:thandle;\r
+ OsVersion : TOSVersionInfo;\r
+{$endif}\r
+ filenamesuffix:ansistring;\r
+begin\r
+ {$ifdef mswindows}\r
+\r
+ ZeroMemory(@OsVersion, SizeOf(OsVersion));\r
+ OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);\r
+\r
+ if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT)) then begin\r
+ filenamesuffix := '\system32\drivers\etc\hosts';\r
+ end else begin\r
+ filenamesuffix := '\hosts';\r
+ end;\r
+\r
+ //first try "user" windows directory. on a multiuser this may not be c:\windows\r
+ GetWindowsDirectoryA(windir,255);\r
+ result := windir;\r
+ if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);\r
+ result := result + filenamesuffix;\r
+\r
+ if not fileexists(result) then begin\r
+ //then try "system" windows directory which is typically c:\windows on a multiuser system\r
+ dllhandle := loadlibrary('kernel32.dll');\r
+ if (dllhandle <> 0) then begin\r
+ GetSystemWindowsDirectoryA := getprocaddress(dllhandle,'GetSystemWindowsDirectoryA');\r
+ if assigned(GetSystemWindowsDirectoryA) then begin\r
+ GetSystemWindowsDirectoryA(windir,255);\r
+ freelibrary(dllhandle);\r
+ result := windir;\r
+ if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);\r
+ result := result + filenamesuffix;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+ {$else}\r
+ result := '/etc/hosts';\r
+ {$endif}\r
+end;\r
+\r
+procedure hostsfile_reload;\r
+label lineend;\r
+var\r
+ t:treadtxt;\r
+\r
+ validchar:array[0..255] of boolean;\r
+ ipv4char:array[0..255] of boolean;\r
+ s:ansistring;\r
+ ch:ansichar;\r
+ a,len,field,startindex,labellen:integer;\r
+ lastwasspace,onlyipv4chars:boolean;\r
+ ipstring,hostname:ansistring;\r
+ biniptemp:tbinip;\r
+begin\r
+ hostsfile_clear;\r
+\r
+ if hostsfile_disabled then exit;\r
+ hostsfile_reverseinited := false;\r
+\r
+ //add builtin entries\r
+ hostsfile_add('localhost',ipstrtobinf('127.0.0.1'));\r
+ {$ifdef ipv6}\r
+ hostsfile_add('localhost',ipstrtobinf('::1'));\r
+ {$endif}\r
+\r
+ if hostsfile_onlylocalhost then exit;\r
+\r
+ if (hostsfile_filename = '') then hostsfile_filename := gethostsfilename;\r
+\r
+ //DNS names can only contain lower and uppercase, digits, dash, and dot\r
+ fillchar(validchar,sizeof(validchar),0);\r
+ validchar[ord('.')] := true;\r
+ validchar[ord('-')] := true;\r
+ fillchar(validchar[48],10,1);\r
+ fillchar(validchar[65],26,1);\r
+ fillchar(validchar[97],26,1);\r
+\r
+ //chars that can be in an ipv4 address: digits and dot\r
+ fillchar(ipv4char,sizeof(ipv4char),0);\r
+ ipv4char[ord('.')] := true;\r
+ fillchar(ipv4char[48],10,1);\r
+\r
+ hostsfile_lastfileage := fileage(hostsfile_filename);\r
+ hostsfile_lastcheckts := getts;\r
+ //writeln('------ reloading ',hostsfile_lastfileage);\r
+ try\r
+ t := treadtxt.createf(hostsfile_filename);\r
+ except\r
+ exit;\r
+ end;\r
+ if not assigned(t) then exit;\r
+\r
+ while not t.eof do begin\r
+ s := t.readline;\r
+\r
+ len := length(s);\r
+ if (len > 512) then goto lineend; //sanity check\r
+ field := -1;\r
+ lastwasspace := true;\r
+\r
+ onlyipv4chars := true;\r
+\r
+ //one extra loop iteration at the end with a "pretend space" for easy parsing\r
+ inc(len);\r
+ ipstring := '';\r
+ hostname := '';\r
+ a := 0;\r
+ while (a <= len) do begin\r
+ inc(a);\r
+ if (a >= len) then ch := ' ' else ch := s[a];\r
+\r
+ if (ch = '#') then begin\r
+ //pretend the start of a comment is a space and the end of the line\r
+ ch := ' ';\r
+ len := a;\r
+ end;\r
+\r
+ if (ch = #9) or (ch = ' ') then begin\r
+ if not (lastwasspace) then begin\r
+ if (field = 0) then begin\r
+ ipstring := copy(s,startindex,a - startindex);\r
+ end else if (field >= 1) then begin\r
+ //maximum length of hostname\r
+ if (a - startindex) > 253 then goto lineend;\r
+\r
+ //remove a trailing dot\r
+ //if (labellen = 0) then dec(a);\r
+\r
+ //hostname must not be an empty string\r
+ if (a - startindex) < 1 then goto lineend;\r
+\r
+ hostname := copy(s,startindex,a - startindex);\r
+\r
+ //reject a hosts entry with a name that is a valid ipv4 address.\r
+ //we don't need to check for ipv6 addresses because they have a colon and so aren't valid hostsnames\r
+ //the windows resolver does allow it, but i think it has potential security issues\r
+ if onlyipv4chars then if ipstrtobin(hostname,biniptemp) then goto lineend;\r
+\r
+ if ipstrtobin(ipstring,biniptemp) then begin\r
+ //writeln('!!!hosts file adding ip=',ipstring,'@host=',hostname,'@');\r
+\r
+ hostsfile_add(hostname,biniptemp);\r
+ end;\r
+\r
+ //break scan loop\r
+ //a := len;\r
+ end;\r
+\r
+ end;\r
+\r
+ lastwasspace := true;\r
+ end else begin\r
+ if lastwasspace then begin\r
+ inc(field);\r
+ startindex := a;\r
+ lastwasspace := false;\r
+ labellen := 0;\r
+ end;\r
+ //enforce valid characters in hostname\r
+ if (field = 1) then begin\r
+ if not validchar[ord(ch)] then goto lineend;\r
+ onlyipv4chars := onlyipv4chars and ipv4char[ord(ch)];\r
+ if (ch = '.') then begin\r
+ if (labellen = 0) then goto lineend;\r
+ labellen := 0;\r
+ end else begin\r
+ inc(labellen);\r
+ if (labellen > 63) then goto lineend;\r
+ end;\r
+ end;\r
+ end;\r
+ end;\r
+lineend:\r
+ end;\r
+ t.destroy;\r
+\r
+end;\r
+\r
+\r
+procedure hostsfile_reloadifneeded;\r
+var\r
+ ts:integer;\r
+begin\r
+ if (hostsfile_disabled or hostsfile_onlylocalhost or hostsfile_manualreload) then exit;\r
+ if hostsfile_filename = '' then exit;\r
+\r
+ ts := getts;\r
+ //writeln('reloadifneeded ts=',ts,' oldts=',hostsfile_lastcheckts);\r
+ if not ((ts > hostsfile_lastcheckts + 10000) or (ts < hostsfile_lastcheckts)) then exit;\r
+\r
+ hostsfile_lastcheckts := ts;\r
+\r
+ //writeln('reloadifneeded new=',fileage(hostsfile_filename),' old=',hostsfile_lastfileage);\r
+ if fileage(hostsfile_filename) = hostsfile_lastfileage then exit;\r
+ hostsfile_reload;\r
+end;\r
+\r
+procedure hostsfile_init;\r
+begin\r
+ //writeln('init ',hostsfile_inited);\r
+ if hostsfile_inited then begin\r
+ hostsfile_reloadifneeded;\r
+ exit;\r
+ end;\r
+ hostsfile_inited := true;\r
+ hostsfile_entries := tstringlist.create;\r
+ hostsfile_entries.casesensitive := false;\r
+ hostsfile_entries.sorted := true;\r
+ hostsfile_entries.duplicates := dupignore;\r
+\r
+ hostsfile_reverseentries := tstringlist.create;\r
+ hostsfile_reverseentries.casesensitive := true;\r
+ hostsfile_reverseentries.sorted := true;\r
+ hostsfile_reverseentries.duplicates := dupignore;\r
+\r
+ hostsfile_reload;\r
+end;\r
+\r
+procedure dnscore_preinit(alsoreverse:boolean);\r
+begin\r
+ {$ifdef ipv6}\r
+ initpreferredmode;\r
+ {$endif}\r
+ hostsfile_init;\r
+ populatednsserverlist;\r
+ randomdword;\r
+ if alsoreverse then hostsfile_initreverse;\r
+end;\r
lcore.org gitweb / lcore.git / blobdiff