netdb.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2003 by the Free Pascal development team
  5. Implement networking routines.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. {$h+}
  14. unit netdb;
  15. Interface
  16. {$i hsh.inc} // disappears if part of resolve.pp !!
  17. Const
  18. DNSPort = 53;
  19. MaxServers = 4;
  20. MaxResolveAddr = 10;
  21. SResolveFile = '/etc/resolv.conf';
  22. SServicesFile = '/etc/services';
  23. SHostsFile = '/etc/hosts';
  24. SNetworksFile = '/etc/networks';
  25. Type
  26. TDNSServerArray = Array[1..MaxServers] of THostAddr;
  27. TServiceEntry = record
  28. Name : String;
  29. Protocol : String;
  30. Port : Word;
  31. Aliases : String;
  32. end;
  33. THostEntry = record
  34. Name : String;
  35. Addr : THostAddr;
  36. Aliases : String;
  37. end;
  38. TNetworkEntry = Record
  39. Name : String;
  40. Addr : TNetAddr;
  41. Aliases : String;
  42. end;
  43. Var
  44. DNSServers : TDNSServerArray;
  45. DNSServerCount : Integer;
  46. DefaultDomainList : String;
  47. CheckResolveFileAge : Boolean;
  48. TimeOutS,TimeOutMS : Longint;
  49. Function GetDNSServers(FN : String) : Integer;
  50. Function ResolveName(HostName : String; Var Addresses : Array of THostAddr) : Integer;
  51. Function ResolveAddress(HostAddr : THostAddr; Var Addresses : Array of String) : Integer;
  52. Function ResolveHostByName(HostName : String; Var H : THostEntry) : Boolean;
  53. Function ResolveHostByAddr(HostAddr : THostAddr; Var H : THostEntry) : Boolean;
  54. Function GetHostByName(HostName: String; Var H : THostEntry) : boolean;
  55. Function GetHostByAddr(Addr: THostAddr; Var H : THostEntry) : boolean;
  56. Function GetNetworkByName(NetName: String; Var N : TNetworkEntry) : boolean;
  57. Function GetNetworkByAddr(Addr: THostAddr; Var N : TNetworkEntry) : boolean;
  58. Function GetServiceByName(Const Name,Proto : String; Var E : TServiceEntry) : Boolean;
  59. Function GetServiceByPort(Port : Word;Const Proto : String; Var E : TServiceEntry) : Boolean;
  60. Implementation
  61. uses
  62. {$ifdef VER1_0}
  63. Linux,
  64. {$else}
  65. BaseUnix,
  66. {$endif}
  67. sockets,sysutils;
  68. {$i hs.inc}
  69. const
  70. DNSQRY_A = 1; // name to IP address
  71. DNSQRY_AAAA = 28; // name to IP6 address
  72. DNSQRY_PTR = 12; // IP address to name
  73. DNSQRY_MX = 15; // name to MX
  74. DNSQRY_TXT = 16; // name to TXT
  75. // Flags 1
  76. QF_QR = $80;
  77. QF_OPCODE = $78;
  78. QF_AA = $04;
  79. QF_TC = $02; // Truncated.
  80. QF_RD = $01;
  81. // Flags 2
  82. QF_RA = $80;
  83. QF_Z = $70;
  84. QF_RCODE = $0F;
  85. Type
  86. TPayLoad = Array[0..511] of char;
  87. TQueryData = packed Record
  88. id : Array[0..1] of Byte;
  89. flags1 : Byte;
  90. flags2 : Byte;
  91. qdcount : word;
  92. ancount : word;
  93. nscount : word;
  94. arcount : word;
  95. Payload : TPayLoad;
  96. end;
  97. TRRData = Packed record // RR record
  98. Atype : Word; // Answer type
  99. AClass : Word;
  100. TTL : Cardinal;
  101. RDLength : Word;
  102. end;
  103. Var
  104. ResolveFileAge : Longint;
  105. ResolveFileName : String;
  106. { ---------------------------------------------------------------------
  107. Auxiliary functions.
  108. ---------------------------------------------------------------------}
  109. function htonl(i:integer):integer;
  110. begin
  111. {$ifdef ENDIAN_LITTLE}
  112. result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
  113. {$else}
  114. result := i;
  115. {$endif}
  116. end;
  117. Function htons(var W : Word) : word;
  118. begin
  119. {$ifdef ENDIAN_LITTLE}
  120. result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
  121. {$else}
  122. result := w;
  123. {$endif}
  124. end;
  125. Function ntohs(var W : Word) : Word;
  126. begin
  127. {$ifdef ENDIAN_LITTLE}
  128. result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
  129. {$else}
  130. result := w;
  131. {$endif}
  132. end;
  133. function ntohl(i:integer):integer;
  134. begin
  135. {$ifdef ENDIAN_LITTLE}
  136. result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
  137. {$else}
  138. result := i;
  139. {$endif}
  140. end;
  141. { ---------------------------------------------------------------------
  142. Resolve.conf handling
  143. ---------------------------------------------------------------------}
  144. Function GetDNSServers(Fn : String) : Integer;
  145. Var
  146. R : Text;
  147. L : String;
  148. I : Integer;
  149. H : THostAddr;
  150. Function CheckDirective(Dir : String) : Boolean;
  151. Var
  152. P : Integer;
  153. begin
  154. P:=Pos(Dir,L);
  155. Result:=(P<>0);
  156. If Result then
  157. begin
  158. Delete(L,1,P+Length(Dir));
  159. Trim(L);
  160. end;
  161. end;
  162. begin
  163. Result:=0;
  164. ResolveFileName:=Fn;
  165. ResolveFileAge:=FileAge(FN);
  166. {$i-}
  167. Assign(R,FN);
  168. Reset(R);
  169. {$i+}
  170. If (IOResult<>0) then
  171. exit;
  172. Try
  173. While not EOF(R) do
  174. begin
  175. Readln(R,L);
  176. I:=Pos('#',L);
  177. If (I<>0) then
  178. L:=Copy(L,1,I-1);
  179. If CheckDirective('nameserver') then
  180. begin
  181. H:=HostToNet(StrToHostAddr(L));
  182. If (H[1]<>0) then
  183. begin
  184. Inc(Result);
  185. DNSServers[Result]:=H;
  186. end;
  187. end
  188. else if CheckDirective('domain') then
  189. DefaultDomainList:=L
  190. else if CheckDirective('search') then
  191. DefaultDomainList:=L;
  192. end;
  193. Finally
  194. Close(R);
  195. end;
  196. DNSServerCount:=Result;
  197. end;
  198. Procedure CheckResolveFile;
  199. Var
  200. F : Integer;
  201. begin
  202. If CheckResolveFileAge then
  203. begin
  204. F:=FileAge(ResolveFileName);
  205. If ResolveFileAge<F then
  206. GetDnsServers(ResolveFileName);
  207. end;
  208. end;
  209. { ---------------------------------------------------------------------
  210. Payload handling functions.
  211. ---------------------------------------------------------------------}
  212. Procedure DumpPayLoad(Q : TQueryData; L : Integer);
  213. Var
  214. i : Integer;
  215. begin
  216. Writeln('Payload : ',l);
  217. For I:=0 to L-1 do
  218. Write(Byte(Q.Payload[i]),' ');
  219. Writeln;
  220. end;
  221. Function BuildPayLoad(Var Q : TQueryData; Name : String; RR : Word; QClass : Word) : Integer;
  222. Var
  223. P : PByte;
  224. l,S : Integer;
  225. begin
  226. Result:=-1;
  227. If length(Name)>506 then
  228. Exit;
  229. Result:=0;
  230. P:[email protected];
  231. Repeat
  232. L:=Pos('.',Name);
  233. If (L=0) then
  234. S:=Length(Name)
  235. else
  236. S:=L-1;
  237. P[Result]:=S;
  238. Move(Name[1],P[Result+1],S);
  239. Inc(Result,S+1);
  240. If (L>0) then
  241. Delete(Name,1,L);
  242. Until (L=0);
  243. P[Result]:=0;
  244. htons(rr);
  245. Move(rr,P[Result+1],2);
  246. Inc(Result,3);
  247. htons(QClass);
  248. Move(qclass,P[Result],2);
  249. Inc(Result,2);
  250. end;
  251. Function NextRR(Const PayLoad : TPayLoad;Var Start : LongInt; AnsLen : LongInt; Var RR : TRRData) : Boolean;
  252. Var
  253. I : Integer;
  254. HaveName : Boolean;
  255. PA : ^TRRData;
  256. RClass,RType : Word;
  257. begin
  258. Result:=False;
  259. I:=Start;
  260. // Skip labels and pointers. At least 1 label or pointer is present.
  261. Repeat
  262. HaveName:=True;
  263. If (Payload[i]>#63) then // Pointer, skip
  264. Inc(I,2)
  265. else If Payload[i]=#0 then // Null termination of label, skip.
  266. Inc(i)
  267. else
  268. begin
  269. Inc(I,Ord(Payload[i])+1); // Label, continue scan.
  270. HaveName:=False;
  271. end;
  272. Until HaveName or (I>(AnsLen-SizeOf(TRRData)));
  273. Result:=(I<=(AnsLen-SizeOf(TRRData)));
  274. // Check RR record.
  275. PA:=@Payload[i];
  276. RR:=PA^;
  277. Start:=I+SizeOf(TRRData);
  278. end;
  279. Function BuildName (Const PayLoad : TPayLoad; Start,len : Integer) : String;
  280. Const
  281. FIREDNS_POINTER_VALUE = $C000;
  282. Var
  283. I,O : Integer;
  284. P : Word;
  285. begin
  286. SetLength(Result,512);
  287. I:=Start;
  288. O:=1;
  289. // Copy labels and pointers. At least 1 label or pointer is present.
  290. Repeat
  291. If (Payload[i]>#63) then // Pointer, move.
  292. begin
  293. Move(Payload[i],P,2);
  294. I:=ntohs(p)-FIREDNS_POINTER_VALUE-12;
  295. end
  296. else if Payload[i]<>#0 then // Label, copy
  297. begin
  298. If O<>1 then
  299. begin
  300. Result[O]:='.';
  301. Inc(O);
  302. end;
  303. P:=Ord(Payload[i]);
  304. Move(Payload[i+1],Result[o],P);
  305. Inc(I,P+1);
  306. Inc(O,P);
  307. end;
  308. Until (Payload[I]=#0);
  309. end;
  310. { ---------------------------------------------------------------------
  311. QueryData handling functions
  312. ---------------------------------------------------------------------}
  313. Function CheckAnswer(Const Qry : TQueryData; Var Ans : TQueryData) : Boolean;
  314. begin
  315. Result:=False;
  316. With Ans do
  317. begin
  318. // Check ID.
  319. If (ID[1]<>QRY.ID[1]) or (ID[0]<>Qry.ID[0]) then
  320. exit;
  321. // Flags ?
  322. If (Flags1 and QF_QR)=0 then
  323. exit;
  324. if (Flags1 and QF_OPCODE)<>0 then
  325. exit;
  326. if (Flags2 and QF_RCODE)<>0 then
  327. exit;
  328. // Number of answers ?
  329. htons(Ancount);
  330. If Ancount<1 then
  331. Exit;
  332. Result:=True;
  333. end;
  334. end;
  335. Function SkipAnsQueries(Var Ans : TQueryData; L : Integer) : integer;
  336. Var
  337. Q,I : Integer;
  338. begin
  339. Result:=0;
  340. With Ans do
  341. begin
  342. htons(qdcount);
  343. i:=0;
  344. q:=0;
  345. While (Q<qdcount) and (i<l) do
  346. begin
  347. If Ord(Payload[i])>63 then
  348. begin
  349. Inc(I,6);
  350. Inc(Q);
  351. end
  352. else
  353. begin
  354. If Payload[i]=#0 then
  355. begin
  356. inc(q);
  357. Inc(I,5);
  358. end
  359. else
  360. Inc(I,Ord(Payload[i])+1);
  361. end;
  362. end;
  363. Result:=I;
  364. end;
  365. end;
  366. { ---------------------------------------------------------------------
  367. DNS Query functions.
  368. ---------------------------------------------------------------------}
  369. Function Query(Resolver : Integer; Var Qry,Ans : TQueryData; QryLen : Integer; Var AnsLen : Integer) : Boolean;
  370. Var
  371. BA,SA : TInetSockAddr;
  372. Sock,L,I : Longint;
  373. Al,RTO : Longint;
  374. ReadFDS : {$ifdef VER1_0}FDSet{$ELSE}TFDSet{$ENDIF};
  375. begin
  376. Result:=False;
  377. With Qry do
  378. begin
  379. ID[0]:=Random(256);
  380. ID[1]:=Random(256);
  381. Flags1:=QF_RD;
  382. Flags2:=0;
  383. qdcount:=1 shl 8;
  384. ancount:=0;
  385. nscount:=0;
  386. arcount:=0;
  387. end;
  388. Sock:=Socket(PF_INET,SOCK_DGRAM,0);
  389. If Sock=-1 then
  390. exit;
  391. With SA do
  392. begin
  393. family:=AF_INET;
  394. port:=DNSport;
  395. htons(port);
  396. addr:=cardinal(HostToNet(DNSServers[Resolver]));
  397. end;
  398. sendto(sock,qry,qrylen+12,0,SA,SizeOf(SA));
  399. // Wait for answer.
  400. RTO:=TimeOutS*1000+TimeOutMS;
  401. {$ifdef VER1_0}FD_ZERO{$else}fpFD_ZERO{$endif}(ReadFDS);
  402. {$ifdef VER1_0}
  403. FD_Set(Sock,readfds);
  404. {$else}
  405. fpFD_Set(sock,readfds);
  406. {$endif}
  407. if {$ifdef ver1_0}Select{$else}fpSelect{$endif}(Sock+1,@readfds,Nil,Nil,RTO)<=0 then
  408. begin
  409. {$ifdef VER1_0}fdclose{$ELSE}fpclose{$endif}(Sock);
  410. exit;
  411. end;
  412. AL:=SizeOf(SA);
  413. L:=recvfrom(Sock,ans,SizeOf(Ans),0,SA,AL);
  414. {$ifdef VER1_0}fdclose{$ELSE}fpclose{$endif}(Sock);
  415. // Check lenght answer and fields in header data.
  416. If (L<12) or not CheckAnswer(Qry,Ans) Then
  417. exit;
  418. // Return Payload length.
  419. Anslen:=L-12;
  420. Result:=True;
  421. end;
  422. Function ResolveNameAt(Resolver : Integer; HostName : String; Var Addresses : Array of THostAddr) : Integer;
  423. Var
  424. Qry, Ans : TQueryData;
  425. MaxAnswer,I,QryLen,
  426. AnsLen,AnsStart : Longint;
  427. RR : TRRData;
  428. begin
  429. Result:=0;
  430. QryLen:=BuildPayLoad(Qry,HostName,DNSQRY_A,1);
  431. If Not Query(Resolver,Qry,Ans,QryLen,AnsLen) then
  432. Result:=-1
  433. else
  434. begin
  435. AnsStart:=SkipAnsQueries(Ans,AnsLen);
  436. MaxAnswer:=Ans.AnCount-1;
  437. If MaxAnswer>High(Addresses) then
  438. MaxAnswer:=High(Addresses);
  439. I:=0;
  440. While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
  441. begin
  442. if (Ntohs(RR.AType)=DNSQRY_A) and (1=NtoHS(RR.AClass)) then
  443. begin
  444. Move(Ans.PayLoad[AnsStart],Addresses[i],SizeOf(THostAddr));
  445. inc(Result);
  446. Inc(AnsStart,RR.RDLength);
  447. end;
  448. Inc(I);
  449. end;
  450. end;
  451. end;
  452. Function ResolveName(HostName : String; Var Addresses : Array of THostAddr) : Integer;
  453. Var
  454. I : Integer;
  455. begin
  456. CheckResolveFile;
  457. I:=1;
  458. Result:=0;
  459. While (Result=0) and (I<=DNSServerCount) do
  460. begin
  461. Result:=ResolveNameAt(I,HostName,Addresses);
  462. Inc(I);
  463. end;
  464. end;
  465. Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String) : Integer;
  466. Var
  467. Qry, Ans : TQueryData;
  468. MaxAnswer,I,QryLen,
  469. AnsLen,AnsStart : Longint;
  470. RR : TRRData;
  471. S : String;
  472. begin
  473. Result:=0;
  474. QryLen:=BuildPayLoad(Qry,Address,DNSQRY_PTR,1);
  475. If Not Query(Resolver,Qry,Ans,QryLen,AnsLen) then
  476. Result:=-1
  477. else
  478. begin
  479. AnsStart:=SkipAnsQueries(Ans,AnsLen);
  480. MaxAnswer:=Ans.AnCount-1;
  481. If MaxAnswer>High(Names) then
  482. MaxAnswer:=High(Names);
  483. I:=0;
  484. While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
  485. begin
  486. if (Ntohs(RR.AType)=DNSQRY_PTR) and (1=NtoHS(RR.AClass)) then
  487. begin
  488. Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
  489. inc(Result);
  490. Inc(AnsStart,RR.RDLength);
  491. end;
  492. Inc(I);
  493. end;
  494. end;
  495. end;
  496. Function ResolveAddress(HostAddr : THostAddr; Var Addresses : Array of String) : Integer;
  497. Var
  498. I : Integer;
  499. S : String;
  500. begin
  501. CheckResolveFile;
  502. I:=1;
  503. Result:=0;
  504. S:=Format('%d.%d.%d.%d.in-addr.arpa',[HostAddr[4],HostAddr[3],HostAddr[2],HostAddr[1]]);
  505. While (Result=0) and (I<=DNSServerCount) do
  506. begin
  507. Result:=ResolveAddressAt(I,S,Addresses);
  508. Inc(I);
  509. end;
  510. end;
  511. Function ResolveHostByName(HostName : String; Var H : THostEntry) : Boolean;
  512. Var
  513. Address : Array[1..MaxResolveAddr] of THostAddr;
  514. L : Integer;
  515. begin
  516. L:=ResolveName(HostName,Address);
  517. Result:=(L>0);
  518. If Result then
  519. begin
  520. // We could add a reverse call here to get the real name and aliases.
  521. H.Name:=HostName;
  522. H.Addr:=Address[1];
  523. H.aliases:='';
  524. end;
  525. end;
  526. Function ResolveHostByAddr(HostAddr : THostAddr; Var H : THostEntry) : Boolean;
  527. Var
  528. Names : Array[1..MaxResolveAddr] of String;
  529. I,L : Integer;
  530. begin
  531. L:=ResolveAddress(HostAddr,Names);
  532. Result:=(L>0);
  533. If Result then
  534. begin
  535. H.Name:=Names[1];
  536. H.Addr:=HostAddr;
  537. H.Aliases:='';
  538. If (L>1) then
  539. For I:=2 to L do
  540. If (I=2) then
  541. H.Aliases:=Names[i]
  542. else
  543. H.Aliases:=H.Aliases+','+Names[i];
  544. end;
  545. end;
  546. { ---------------------------------------------------------------------
  547. Some Parsing routines
  548. ---------------------------------------------------------------------}
  549. Const
  550. Whitespace = [' ',#9];
  551. Function NextWord(Var Line : String) : String;
  552. Var
  553. I,J : Integer;
  554. begin
  555. I:=1;
  556. While (I<=Length(Line)) and (Line[i] in Whitespace) do
  557. inc(I);
  558. J:=I;
  559. While (J<=Length(Line)) and Not (Line[J] in WhiteSpace) do
  560. inc(j);
  561. Result:=Copy(Line,I,J-1);
  562. Delete(Line,1,J);
  563. end;
  564. Procedure StripComment(Var line : String);
  565. Var
  566. P : Integer;
  567. begin
  568. P:=Pos('#',Line);
  569. If (P<>0) then
  570. Line:=Trim(Copy(Line,1,P-1));
  571. end;
  572. Function MatchNameOrAlias(Const Entry,Name: String; Aliases : String) : Boolean;
  573. Var
  574. P : Integer;
  575. A : String;
  576. begin
  577. Result:=CompareText(Entry,Name)=0;
  578. If Not Result then
  579. While (Not Result) and (Length(Aliases)>0) do
  580. begin
  581. P:=Pos(',',Aliases);
  582. If (P=0) then
  583. P:=Length(Aliases)+1;
  584. A:=Copy(Aliases,1,P-1);
  585. Delete(Aliases,1,P);
  586. Result:=CompareText(A,Entry)=0;
  587. end;
  588. end;
  589. { ---------------------------------------------------------------------
  590. /etc/hosts handling.
  591. ---------------------------------------------------------------------}
  592. Function GetNextHostEntry(var F : Text; Var H : THostEntry): boolean;
  593. Var
  594. Line,S : String;
  595. P : Integer;
  596. begin
  597. Result:=False;
  598. Repeat
  599. ReadLn(F,Line);
  600. StripComment(Line);
  601. S:=NextWord(Line);
  602. If (S<>'') then
  603. begin
  604. H.Addr:=StrToHostAddr(S);
  605. if (H.Addr[1]<>0) then
  606. begin
  607. S:=NextWord(Line);
  608. If (S<>'') then
  609. begin
  610. H.Name:=S;
  611. Result:=True;
  612. H.Aliases:='';
  613. Repeat
  614. S:=NextWord(line);
  615. If (S<>'') then
  616. If (H.Aliases='') then
  617. H.Aliases:=S
  618. else
  619. H.Aliases:=H.Aliases+','+S;
  620. until (S='');
  621. end;
  622. end;
  623. end;
  624. until Result or EOF(F);
  625. end;
  626. Function FindHostEntryInHostsFile(N: String; Addr: THostAddr; Var H : THostEntry) : boolean;
  627. Var
  628. F : Text;
  629. HE : THostEntry;
  630. begin
  631. Result:=False;
  632. If FileExists(SHostsFile) then
  633. begin
  634. Assign(F,SHostsFile);
  635. {$i-}
  636. Reset(F);
  637. {$i+}
  638. If (IOResult=0) then
  639. begin
  640. While Not Result and GetNextHostEntry(F,HE) do
  641. begin
  642. If (N<>'') then
  643. Result:=MatchNameOrAlias(N,HE.Name,HE.Aliases)
  644. else
  645. Result:=Cardinal(Addr)=Cardinal(HE.Addr);
  646. end;
  647. Close(f);
  648. If Result then
  649. begin
  650. H.Name:=HE.Name;
  651. H.Addr:=HE.Addr;
  652. H.Aliases:=HE.Aliases;
  653. end;
  654. end;
  655. end;
  656. end;
  657. Function GetHostByName(HostName: String; Var H : THostEntry) : boolean;
  658. begin
  659. Result:=FindHostEntryInHostsFile(HostName,NoAddress,H);
  660. end;
  661. Function GetHostByAddr(Addr: THostAddr; Var H : THostEntry) : boolean;
  662. begin
  663. Result:=FindHostEntryInHostsFile('',Addr,H);
  664. end;
  665. { ---------------------------------------------------------------------
  666. /etc/networks handling
  667. ---------------------------------------------------------------------}
  668. Function GetNextNetworkEntry(var F : Text; Var N : TNetworkEntry): boolean;
  669. Var
  670. NN,Line,S : String;
  671. P : Integer;
  672. A : TNetAddr;
  673. begin
  674. Result:=False;
  675. Repeat
  676. ReadLn(F,Line);
  677. StripComment(Line);
  678. S:=NextWord(Line);
  679. If (S<>'') then
  680. begin
  681. NN:=S;
  682. A:=StrToHostAddr(NextWord(Line));
  683. Result:=(NN<>'') and (A[1]<>0); // Valid addr.
  684. If result then
  685. begin
  686. N.Addr:=A;
  687. N.Name:=NN;
  688. N.Aliases:='';
  689. end;
  690. end;
  691. until Result or EOF(F);
  692. end;
  693. Function FindNetworkEntryInNetworksFile(Net: String; Addr: TNetAddr; Var N : TNetworkEntry) : boolean;
  694. Var
  695. F : Text;
  696. NE : TNetworkEntry;
  697. begin
  698. Result:=False;
  699. If FileExists(SNetworksFile) then
  700. begin
  701. Assign(F,SNetworksFile);
  702. {$i-}
  703. Reset(F);
  704. {$i+}
  705. If (IOResult=0) then
  706. begin
  707. While Not Result and GetNextNetworkEntry(F,NE) do
  708. begin
  709. If (Net<>'') then
  710. Result:=MatchNameOrAlias(Net,NE.Name,NE.Aliases)
  711. else
  712. Result:=Cardinal(Addr)=Cardinal(NE.Addr);
  713. end;
  714. Close(f);
  715. If Result then
  716. begin
  717. N.Name:=NE.Name;
  718. N.Addr:=NE.Addr;
  719. N.Aliases:=NE.Aliases;
  720. end;
  721. end;
  722. end;
  723. end;
  724. Function GetNetworkByName(NetName: String; Var N : TNetworkEntry) : boolean;
  725. begin
  726. Result:=FindNetworkEntryInNetworksFile(NetName,NoNet,N);
  727. end;
  728. Function GetNetworkByAddr(Addr: THostAddr; Var N : TNetworkEntry) : boolean;
  729. begin
  730. Result:=FindNetworkEntryInNetworksFile('',Addr,N);
  731. end;
  732. { ---------------------------------------------------------------------
  733. /etc/services section
  734. ---------------------------------------------------------------------}
  735. Function GetNextServiceEntry(Var F : Text; Var E : TServiceEntry) : Boolean;
  736. Var
  737. Line,S : String;
  738. P : INteger;
  739. begin
  740. Result:=False;
  741. Repeat
  742. ReadLn(F,Line);
  743. StripComment(Line);
  744. S:=NextWord(Line);
  745. If (S<>'') then
  746. begin
  747. E.Name:=S;
  748. S:=NextWord(Line);
  749. P:=Pos('/',S);
  750. If (P<>0) then
  751. begin
  752. E.Port:=StrToIntDef(Copy(S,1,P-1),0);
  753. If (E.Port<>0) then
  754. begin
  755. E.Protocol:=Copy(S,P+1,Length(S)-P);
  756. Result:=length(E.Protocol)>0;
  757. E.Aliases:='';
  758. Repeat
  759. S:=NextWord(Line);
  760. If (S<>'') then
  761. If (Length(E.Aliases)=0) then
  762. E.aliases:=S
  763. else
  764. E.Aliases:=E.Aliases+','+S;
  765. until (S='');
  766. end;
  767. end;
  768. end;
  769. until Result or EOF(F);
  770. end;
  771. Function FindServiceEntryInFile(Const Name,Proto : String; Port : Integer; Var E : TServiceEntry) : Boolean;
  772. Var
  773. F : Text;
  774. TE : TServiceEntry;
  775. begin
  776. Result:=False;
  777. If FileExists(SServicesFile) then
  778. begin
  779. Assign(F,SServicesFile);
  780. {$i-}
  781. Reset(F);
  782. {$i+}
  783. If (IOResult=0) then
  784. begin
  785. While Not Result and GetNextServiceEntry(F,TE) do
  786. begin
  787. If (Port=-1) then
  788. Result:=MatchNameOrAlias(Name,TE.Name,TE.Aliases)
  789. else
  790. Result:=(Port=TE.Port);
  791. If Result and (Proto<>'') then
  792. Result:=(Proto=TE.Protocol);
  793. end;
  794. Close(f);
  795. If Result then
  796. begin
  797. E.Name:=TE.Name;
  798. E.Port:=TE.Port;
  799. E.Protocol:=TE.Protocol;
  800. E.Aliases:=TE.Aliases;
  801. end;
  802. end;
  803. end;
  804. end;
  805. Function GetServiceByName(Const Name,Proto : String; Var E : TServiceEntry) : Boolean;
  806. begin
  807. Result:=FindServiceEntryInFile(Name,Proto,-1,E);
  808. end;
  809. Function GetServiceByPort(Port : Word;Const Proto : String; Var E : TServiceEntry) : Boolean;
  810. begin
  811. Result:=FindServiceEntryInFile('',Proto,Port,E);
  812. end;
  813. { ---------------------------------------------------------------------
  814. Initialization section
  815. ---------------------------------------------------------------------}
  816. Procedure InitResolver;
  817. Var
  818. I : Integer;
  819. begin
  820. TimeOutS :=5;
  821. TimeOutMS:=0;
  822. CheckResolveFileAge:=False;
  823. If FileExists(SResolveFile) then
  824. GetDNsservers(SResolveFile);
  825. end;
  826. begin
  827. InitResolver;
  828. end.
  829. {
  830. $Log$
  831. Revision 1.7 2003-09-29 19:21:19 marco
  832. * ; added to line 150
  833. Revision 1.6 2003/09/29 07:44:11 michael
  834. + Endian patch from bas [email protected]
  835. Revision 1.5 2003/09/28 09:34:02 peter
  836. * unix fix for 1.0.x
  837. Revision 1.4 2003/09/18 16:30:23 marco
  838. * unixreform fix
  839. Revision 1.3 2003/05/17 20:54:03 michael
  840. + uriparser unit added. Header/Footer blocks added
  841. }