netdb.pp 21 KB

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