PageRenderTime 39ms CodeModel.GetById 15ms RepoModel.GetById 0ms app.codeStats 0ms

/ProSnooperFx_src/indy10.0.52_source/Protocols/IdDNSServer.pas

http://github.com/lookias/ProSnooper
Pascal | 4049 lines | 3310 code | 269 blank | 470 comment | 196 complexity | 578e8e1fa30ee866d6d6ba8e0a7036dd MD5 | raw file
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 13802: IdDNSServer.pas
  11. {
  12. { Rev 1.33 2004.10.27 9:17:46 AM czhower
  13. { For TIdStrings
  14. }
  15. {
  16. { Rev 1.32 10/26/2004 9:06:32 PM JPMugaas
  17. { Updated references.
  18. }
  19. {
  20. { Rev 1.31 2004.10.26 1:06:26 PM czhower
  21. { Further fixes for aliaser
  22. }
  23. {
  24. { Rev 1.30 2004.10.26 12:01:32 PM czhower
  25. { Resolved alias conflict.
  26. }
  27. {
  28. Rev 1.29 9/15/2004 4:59:52 PM DSiders
  29. Added localization comments.
  30. }
  31. {
  32. { Rev 1.28 22/07/2004 18:14:22 ANeillans
  33. { Fixed compile error.
  34. }
  35. {
  36. { Rev 1.27 7/21/04 2:38:04 PM RLebeau
  37. { Removed redundant string copying in TIdDNS_ProcessThread constructor and
  38. { procedure QueryDomain() method
  39. {
  40. { Removed local variable from TIdDNS_ProcessThread.SendData(), not needed
  41. }
  42. {
  43. { Rev 1.26 2004/7/21 U 06:37:48 DChang
  44. { Fix compile error in TIdDNS_ProcessThread.SendData, and mark a case statment
  45. { to comments in TIdDNS_ProcessThread.SaveToCache.
  46. }
  47. {
  48. { Rev 1.25 2004/7/19 U 09:55:52 DChang
  49. { 1. Move all textmoderecords to IdDNSCommon.pas
  50. { 2.Making DNS Server load the domain definition file while DNS Server
  51. { component is active.
  52. { 3. Add a new event : OnAfterCacheSaved
  53. { 4. Add Full name condition to indicate if a domain is empty
  54. { (ConvertDNtoString)
  55. { 5. Make Query request processed with independent thread.
  56. { 6. Rewrite TIdDNSServer into multiple thread mode, all queries will search
  57. { and assemble the answer, and then share the TIdSocketHandle to send answer
  58. { back.
  59. { 7. Add version information in TIdDNSServer, so class CHAOS can be taken, but
  60. { only for the label : "version.bind.".
  61. { 8. Fix TIdRR_TXT.BinQueryRecord, to make sure it can be parsed in DNS client.
  62. { 9. Modify the AXFR function, reduce the response data size and quantity.
  63. { 10. Move all TIdTextModeResourceRecord and derived classes to IdDNSCommon.pas
  64. }
  65. {
  66. { Rev 1.24 7/8/04 11:43:54 PM RLebeau
  67. { Updated TIdDNS_TCPServer.DoConnect() to use new BytesToString() parameters
  68. }
  69. {
  70. { Rev 1.23 7/7/04 1:45:16 PM RLebeau
  71. { Compiler fixes
  72. }
  73. {
  74. { Rev 1.22 6/29/04 1:43:30 PM RLebeau
  75. { Bug fixes for various property setters
  76. }
  77. {
  78. { Rev 1.21 2004.05.20 1:39:32 PM czhower
  79. { Last of the IdStream updates
  80. }
  81. {
  82. { Rev 1.20 2004.03.01 9:37:06 PM czhower
  83. { Fixed name conflicts for .net
  84. }
  85. {
  86. { Rev 1.19 2004.02.07 5:03:32 PM czhower
  87. { .net fixes.
  88. }
  89. {
  90. { Rev 1.18 2/7/2004 5:39:44 AM JPMugaas
  91. { IdDNSServer should compile in both DotNET and WIn32.
  92. }
  93. {
  94. { Rev 1.17 2004.02.03 5:45:58 PM czhower
  95. { Name changes
  96. }
  97. {
  98. { Rev 1.16 1/22/2004 8:26:40 AM JPMugaas
  99. { Ansi* calls changed.
  100. }
  101. {
  102. { Rev 1.15 1/21/2004 2:12:48 PM JPMugaas
  103. { InitComponent
  104. }
  105. {
  106. { Rev 1.14 12/7/2003 8:07:26 PM VVassiliev
  107. { string -> TIdBytes
  108. }
  109. {
  110. { Rev 1.13 2003.10.24 10:38:24 AM czhower
  111. { UDP Server todos
  112. }
  113. {
  114. Rev 1.12 10/19/2003 12:16:30 PM DSiders
  115. Added localization comments.
  116. }
  117. {
  118. { Rev 1.11 2003.10.12 3:50:40 PM czhower
  119. { Compile todos
  120. }
  121. {
  122. { Rev 1.10 2003/5/14 W 01:17:36 DChang
  123. { Fix a flag named denoted in the function which check if a domain correct.
  124. { Update the logic of UpdateTree functions (make them unified).
  125. { Update the TextRecord function of all TIdRR_ classes, it checks if the RRName
  126. { the same as FullName, if RRName = FullName, it will not append the Fullname
  127. { to RRName.
  128. }
  129. {
  130. { Rev 1.9 2003/5/10 W 01:09:42 DChang
  131. { Patch the domainlist update when axfr action.
  132. }
  133. {
  134. { Rev 1.8 2003/5/9 W 10:03:36 DChang
  135. { Modify the sequence of records. To make sure when we resolve MX record, the
  136. { mail host A record can be additional record section.
  137. }
  138. {
  139. { Rev 1.7 2003/5/8 U 08:11:34 DChang
  140. { Add TIdDNSMap, TIdDomainNameServerMapping to monitor primary DNS, and
  141. { detecting if the primary DNS record changed, it will update automatically if
  142. { necessary.
  143. }
  144. {
  145. { Rev 1.6 2003/5/2 U 03:39:38 DChang
  146. { Fix all compile warnings and hints.
  147. }
  148. {
  149. { Rev 1.5 4/29/2003 08:26:30 PM DenniesChang
  150. { Fix TIdDNSServer Create, the older version miss to create the FBindings.
  151. { fix AXFR procedure, fully support BIND 8 AXFR procedures.
  152. }
  153. { Rev 1.4 4/28/2003 02:30:58 PM JPMugaas
  154. { reverted back to the old one as the new one checked will not compile, has
  155. { problametic dependancies on Contrs and Dialogs (both not permitted).
  156. }
  157. { Rev 1.3 04/28/2003 01:15:10 AM DenniesChang
  158. }
  159. {
  160. { Rev 1.2 4/28/2003 07:00:18 AM JPMugaas
  161. { Should now compile.
  162. }
  163. {
  164. { Rev 1.0 11/14/2002 02:18:42 PM JPMugaas
  165. }
  166. {
  167. // Ver: 2003-04-28-0115
  168. // Combine TCP, UDP Tunnel into single TIdDNSServer component.
  169. // Update TIdDNSServer from TIdUDPServer to TComponent.
  170. // Ver: 2003-04-26-1810
  171. // Add AXFR command.
  172. // Ver: 2002-10-30-1253
  173. // Add TIdRR_AAAA class, RFC 1884 (Ipv6 AAAA)
  174. // and add the coresponding fix in TIdDNSServer, but left
  175. // external search option for future.
  176. // Ver: 2002-07-10-1610
  177. // Add a new event : OnAfterSendBack to handle all
  178. // data logged after query result is sent back to
  179. // the client.
  180. // Ver: 2002-05-27-0910
  181. // Add a check function in SOA loading function.
  182. // Ver: 2002-04-25-1530
  183. // IdDNSServer. Ver: 2002-03-12-0900
  184. // To-do: RFC 2136 Zone transfer must be implemented.
  185. // Add FindHandedNodeByName to pass the TIdDNTreeNode Object back.
  186. // Append a blank char when ClearQuota, to avoid the possible of
  187. // losting a field.
  188. // Add IdDNTree.SaveToFile
  189. // Fix SOA RRName assignment.
  190. // Fix PTRName RRName assignment.
  191. // Fix TIdDNTreeNode RemoveChild
  192. // IdDNSServer. Ver: 2002-02-26-1420
  193. // Convert the DN Tree Node type, earlier verison just
  194. // store the A, PTR in the upper domain node, current
  195. // version save SOA and its subdomain in upper node.
  196. //
  197. // Moreover, move Cached_Tree, Handed_Tree to public
  198. // section, for using convinent.
  199. //
  200. // I forget return CName data, fixed.
  201. // Seperate the seaching of Cache and handled tree into 2
  202. // parts with a flag.
  203. //IdDNSServer. Ver: 2002-02-24-1715
  204. // Move TIdDNSServer protected property RootDNS_NET to public
  205. //IdDNSServer. Ver: 2002-02-23-1800
  206. Original Programmer: Dennies Chang <dennies@ms4.hinet.net>
  207. No Copyright. Code is given to the Indy Pit Crew.
  208. This DNS Server supports only IN record, but not Chaos system.
  209. Most of resource records in DNS server was stored with text mode,
  210. event the TREE structure, it's just for convininet.
  211. Why I did it with this way is tring to increase the speed for
  212. implementation, with Delphi/Kylix internal class and object,
  213. we can promise the compatible in Windows and Linux.
  214. Started: Jan. 20, 2002.
  215. First Finished: Feb. 23, 2002.
  216. RFC 1035 WKS record is not implemented.
  217. ToDO: Load Master File automaticlly when DNS Server Active.
  218. ToDO: patch WKS record data type.
  219. ToDO: prepare a Tree Editor for DNS Server Construction. (optional)
  220. }
  221. unit IdDNSServer;
  222. interface
  223. uses
  224. Classes,
  225. IdContainers,
  226. SysUtils,
  227. IdAssignedNumbers,
  228. IdSocketHandle,
  229. IdIOHandlerSocket,
  230. IdGlobal,
  231. IdGlobalProtocols,
  232. IdBaseComponent,
  233. IdComponent,
  234. IdContext,
  235. IdUDPBase, IdResourceStrings,
  236. IdExceptionCore,
  237. IdDNSResolver,
  238. IdUDPServer,
  239. IdTCPServer,
  240. IdThread,
  241. IdDNSCommon,
  242. IdTStrings;
  243. type
  244. TIdDomainExpireCheckThread = class (TIdThread)
  245. protected
  246. FInterval: Cardinal;
  247. FSender: TObject;
  248. FTimerEvent: TNotifyEvent;
  249. FBusy : boolean;
  250. FDomain : string;
  251. FHost : string;
  252. //
  253. procedure Run; override;
  254. procedure TimerEvent;
  255. end;
  256. // forward declaration.
  257. TIdDNSMap = class;
  258. TIdDNS_UDPServer = class;
  259. // This class is to record the mapping of Domain and its primary DNS IP
  260. TIdDomainNameServerMapping = class (TObject)
  261. private
  262. FHost: string;
  263. FDomainName: string;
  264. FBusy : boolean;
  265. FInterval: Cardinal;
  266. FList: TIdDNSMap;
  267. procedure SetHost(const Value: string);
  268. procedure SetInterval(const Value: Cardinal);
  269. protected
  270. CheckScheduler : TIdDomainExpireCheckThread;
  271. property Interval : Cardinal read FInterval write SetInterval;
  272. property List : TIdDNSMap read FList write FList;
  273. public
  274. constructor Create(List :TIdDNSMap);
  275. destructor Destroy; override;
  276. published
  277. procedure SyncAndUpdate (Sender : TObject);
  278. property Host : string read FHost write SetHost;
  279. property DomainName : string read FDomainName write FDomainName;
  280. end;
  281. TIdDNSMap = class (TIdObjectList)
  282. private
  283. FServer: TIdDNS_UDPServer;
  284. function GetItem(Index: Integer): TIdDomainNameServerMapping;
  285. procedure SetItem(Index: Integer;
  286. const Value: TIdDomainNameServerMapping);
  287. procedure SetServer(const Value: TIdDNS_UDPServer);
  288. public
  289. constructor Create(Server: TIdDNS_UDPServer);
  290. destructor Destroy; override;
  291. property Server : TIdDNS_UDPServer read FServer write SetServer;
  292. property Items[Index: Integer]: TIdDomainNameServerMapping read GetItem write SetItem; default;
  293. end;
  294. TIdMWayTreeNodeClass = class of TIdMWayTreeNode;
  295. TIdMWayTreeNode = class (TObject)
  296. private
  297. SubTree : TIdObjectList;
  298. FFundmentalClass: TIdMWayTreeNodeClass;
  299. function GetTreeNode(Index: integer): TIdMWayTreeNode;
  300. procedure SetFundmentalClass(const Value: TIdMWayTreeNodeClass);
  301. procedure SetTreeNode(Index: integer; const Value: TIdMWayTreeNode);
  302. public
  303. constructor Create(NodeClass : TIdMWayTreeNodeClass); virtual;
  304. destructor Destroy; override;
  305. property FundmentalClass : TIdMWayTreeNodeClass read FFundmentalClass write SetFundmentalClass;
  306. property Children[Index : integer] : TIdMWayTreeNode read GetTreeNode write SetTreeNode;
  307. function AddChild : TIdMWayTreeNode;
  308. function InsertChild(Index : integer) : TIdMWayTreeNode;
  309. procedure RemoveChild(Index : integer);
  310. end;
  311. TIdDNTreeNode = class (TIdMWayTreeNode)
  312. private
  313. FCLabel : AnsiString;
  314. FRRs: TIdTextModeRRs;
  315. FChildIndex: TStrings;
  316. FParentNode: TIdDNTreeNode;
  317. FAutoSortChild: boolean;
  318. procedure SetCLabel(const Value: AnsiString);
  319. procedure SetRRs(const Value: TIdTextModeRRs);
  320. function GetNode(Index: integer): TIdDNTreeNode;
  321. procedure SetNode(Index: integer; const Value: TIdDNTreeNode);
  322. procedure SetChildIndex(const Value: TStrings);
  323. function GetFullName: string;
  324. function ConvertToDNString : string;
  325. function DumpAllBinaryData(var RecordCount:integer) : TIdBytes;
  326. public
  327. property ParentNode : TIdDNTreeNode read FParentNode write FParentNode;
  328. property CLabel : AnsiString read FCLabel write SetCLabel;
  329. property RRs : TIdTextModeRRs read FRRs write SetRRs;
  330. property Children[Index : integer] : TIdDNTreeNode read GetNode write SetNode;
  331. property ChildIndex : TStrings read FChildIndex write SetChildIndex;
  332. property AutoSortChild : boolean read FAutoSortChild write FAutoSortChild;
  333. property FullName : string read GetFullName;
  334. constructor Create(ParentNode : TIdDNTreeNode); reintroduce;
  335. destructor Destroy; override;
  336. function AddChild : TIdDNTreeNode;
  337. function InsertChild(Index : integer) : TIdDNTreeNode;
  338. procedure RemoveChild(Index : integer);
  339. procedure SortChildren;
  340. procedure Clear;
  341. procedure SaveToFile(Filename : TFilename);
  342. function IndexByLabel(CLabel : AnsiString): integer;
  343. function IndexByNode(ANode : TIdDNTreeNode) : integer;
  344. end;
  345. TIdDNS_TCPServer = class (TIdTCPServer)
  346. protected
  347. FAccessList: TIdStrings;
  348. FAccessControl: boolean;
  349. //
  350. procedure DoConnect(AThread: TIdContext); override;
  351. procedure InitComponent; override;
  352. procedure SetAccessList(const Value: TIdStrings);
  353. public
  354. destructor Destroy; override;
  355. published
  356. property AccessList : TIdStrings read FAccessList write SetAccessList;
  357. property AccessControl : boolean read FAccessControl write FAccessControl;
  358. end;
  359. TIdDNS_ProcessThread = class (TIdThread)
  360. protected
  361. FMyBinding: TIdSocketHandle;
  362. FMainBinding: TIdSocketHandle;
  363. FMyData: TStream;
  364. FData : string;
  365. FDataSize : integer;
  366. FServer: TIdDNS_UDPServer;
  367. procedure SetMyBinding(const Value: TIdSocketHandle);
  368. procedure SetMyData(const Value: TStream);
  369. procedure SetServer(const Value: TIdDNS_UDPServer);
  370. procedure ComposeErrorResult(var Final: TIdBytes;
  371. OriginalHeader: TDNSHeader; OriginalQuestion : TIdBytes;
  372. ErrorStatus: integer);
  373. function CombineAnswer(Header : TDNSHeader; EQuery, Answer : TIdBytes): TIdBytes;
  374. procedure InternalSearch(Header: TDNSHeader; QName: string; QType: Word;
  375. var Answer: TIdBytes; IfMainQuestion: boolean; IsSearchCache: boolean = false;
  376. IsAdditional: boolean = false; IsWildCard : boolean = false;
  377. WildCardOrgName: string = '');
  378. procedure ExternalSearch(aDNSResolver: TIdDNSResolver; Header: TDNSHeader;
  379. Question: TIdBytes; var Answer: TIdBytes);
  380. function CompleteQuery(DNSHeader: TDNSHeader; Question: string;
  381. OriginalQuestion: TIdBytes; var Answer : TIdBytes; QType, QClass : word;
  382. DNSResolver : TIdDNSResolver) : string;
  383. procedure SaveToCache(ResourceRecord : string; QueryName : string; OriginalQType : Word);
  384. function SearchTree(Root : TIdDNTreeNode; QName : String; QType : Word): TIdDNTreeNode;
  385. procedure Run; override;
  386. procedure QueryDomain;
  387. procedure SendData;
  388. public
  389. property MyBinding : TIdSocketHandle read FMyBinding write SetMyBinding;
  390. property MyData: TStream read FMyData write SetMyData;
  391. property Server : TIdDNS_UDPServer read FServer write SetServer;
  392. constructor Create(ACreateSuspended: Boolean = True;
  393. Data : String = ''; DataSize : integer = 0;
  394. MainBinding : TIdSocketHandle = nil;
  395. Binding : TIdSocketHandle = nil;
  396. Server : TIdDNS_UDPServer = nil); reintroduce; overload;
  397. destructor Destroy; override;
  398. end;
  399. TIdDNSBeforeQueryEvent = procedure(ABinding: TIdSocketHandle;
  400. ADNSHeader: TDNSHeader; var ADNSQuery: string) of object;
  401. TIdDNSAfterQueryEvent = procedure(ABinding: TIdSocketHandle;
  402. ADNSHeader: TDNSHeader; var QueryResult: string; ResultCode: string;
  403. Query : string) of object;
  404. TIdDNSAfterCacheSaved = procedure(CacheRoot : TIdDNTreeNode) of object;
  405. TIdDNS_UDPServer = class (TIdUDPServer)
  406. private
  407. FBusy: boolean;
  408. protected
  409. FAutoUpdateZoneInfo: boolean;
  410. FZoneMasterFiles: TIdStrings;
  411. FRootDNS_NET: TIdStrings;
  412. FCacheUnknowZone: boolean;
  413. FCached_Tree: TIdDNTreeNode;
  414. FHanded_Tree: TIdDNTreeNode;
  415. FHanded_DomainList: TIdStrings;
  416. FAutoLoadMasterFile: Boolean;
  417. FOnAfterQuery: TIdDNSAfterQueryEvent;
  418. FOnBeforeQuery: TIdDNSBeforeQueryEvent;
  419. FCS: TIdCriticalSection;
  420. FOnAfterSendBack: TIdDNSAfterQueryEvent;
  421. FOnAfterCacheSaved: TIdDNSAfterCacheSaved;
  422. FGlobalCS: TIdCriticalSection;
  423. FDNSVersion: string;
  424. FofferDNSVersion: boolean;
  425. procedure DoBeforeQuery(ABinding: TIdSocketHandle;
  426. ADNSHeader: TDNSHeader; var ADNSQuery : String); dynamic;
  427. procedure DoAfterQuery(ABinding: TIdSocketHandle;
  428. ADNSHeader: TDNSHeader; var QueryResult : String;
  429. ResultCode : String; Query : string); dynamic;
  430. procedure DoAfterSendBack(ABinding: TIdSocketHandle;
  431. ADNSHeader: TDNSHeader; var QueryResult : String;
  432. ResultCode : String; Query : string); dynamic;
  433. procedure DoAfterCacheSaved(CacheRoot : TIdDNTreeNode); dynamic;
  434. procedure SetZoneMasterFiles(const Value: TIdStrings);
  435. procedure SetRootDNS_NET(const Value: TIdStrings);
  436. procedure SetHanded_DomainList(const Value: TIdStrings);
  437. procedure InternalSearch(Header: TDNSHeader; QName: string; QType: Word;
  438. var Answer: TIdBytes; IfMainQuestion: boolean; IsSearchCache: boolean = false;
  439. IsAdditional: boolean = false; IsWildCard : boolean = false;
  440. WildCardOrgName: string = '');
  441. procedure ExternalSearch(aDNSResolver: TIdDNSResolver; Header: TDNSHeader;
  442. Question: TIdBytes; var Answer: TIdBytes);
  443. //modified in May 2004 by Dennies Chang.
  444. //procedure SaveToCache(ResourceRecord : string);
  445. procedure SaveToCache(ResourceRecord : string; QueryName : string; OriginalQType : Word);
  446. procedure UpdateTree(TreeRoot : TIdDNTreeNode; RR : TResultRecord); overload;
  447. procedure InitComponent; override;
  448. // Hide this property temporily, this property is prepared to maintain the
  449. // TTL expired record auto updated;
  450. property AutoUpdateZoneInfo : boolean read FAutoUpdateZoneInfo write FAutoUpdateZoneInfo;
  451. property CS: TIdCriticalSection read FCS;
  452. public
  453. destructor Destroy; override;
  454. function AXFR(Header : TDNSHeader; Question : string; var Answer :TIdBytes) : string;
  455. function CompleteQuery(DNSHeader: TDNSHeader; Question: string;
  456. OriginalQuestion: TIdBytes; var Answer : TIdBytes; QType, QClass : word;
  457. DNSResolver : TIdDNSResolver) : string;
  458. function LoadZoneFromMasterFile(MasterFileName : TFileName) : boolean;
  459. function LoadZoneStrings(FileStrings: TIdStrings; Filename : TFilename;
  460. TreeRoot : TIdDNTreeNode): boolean;
  461. function SearchTree(Root : TIdDNTreeNode; QName : String; QType : Word): TIdDNTreeNode;
  462. procedure UpdateTree(TreeRoot : TIdDNTreeNode; RR : TIdTextModeResourceRecord); overload;
  463. function FindNodeFullName(Root : TIdDNTreeNode; QName : String; QType : Word) : string;
  464. function FindHandedNodeByName(QName : String; QType : Word) : TIdDNTreeNode;
  465. //procedure DoUDPRead(AData: TStream; ABinding: TIdSocketHandle); override;
  466. property RootDNS_NET : TIdStrings read FRootDNS_NET write SetRootDNS_NET;
  467. property Cached_Tree : TIdDNTreeNode read FCached_Tree {write SetCached_Tree};
  468. property Handed_Tree : TIdDNTreeNode read FHanded_Tree {write SetHanded_Tree};
  469. property Busy : boolean read FBusy;
  470. property GlobalCS : TIdCriticalSection read FGlobalCS;
  471. published
  472. property DefaultPort default IdPORT_DOMAIN;
  473. property AutoLoadMasterFile : Boolean read FAutoLoadMasterFile write FAutoLoadMasterFile Default False;
  474. //property AutoUpdateZoneInfo : boolean read FAutoUpdateZoneInfo write SetAutoUpdateZoneInfo;
  475. property ZoneMasterFiles : TIdStrings read FZoneMasterFiles write SetZoneMasterFiles;
  476. property CacheUnknowZone : boolean read FCacheUnknowZone write FCacheUnknowZone default False;
  477. property Handed_DomainList : TIdStrings read FHanded_DomainList write SetHanded_DomainList;
  478. property DNSVersion : string read FDNSVersion write FDNSVersion;
  479. property offerDNSVersion : boolean read FofferDNSVersion write FofferDNSVersion;
  480. property OnBeforeQuery : TIdDNSBeforeQueryEvent read FOnBeforeQuery write FOnBeforeQuery;
  481. property OnAfterQuery :TIdDNSAfterQueryEvent read FOnAfterQuery write FOnAfterQuery;
  482. property OnAfterSendBack :TIdDNSAfterQueryEvent read FOnAfterSendBack write FOnAfterSendBack;
  483. property OnAfterCacheSaved : TIdDNSAfterCacheSaved read FOnAfterCacheSaved write FOnAfterCacheSaved;
  484. end;
  485. TIdDNSServer = class (TIdComponent)
  486. protected
  487. FActive: boolean;
  488. FTCPACLActive: boolean;
  489. FServerType: TDNSServerTypes;
  490. FTCPTunnel: TIdDNS_TCPServer;
  491. FUDPTunnel: TIdDNS_UDPServer;
  492. FAccessList: TIdStrings;
  493. FBindings: TIdSocketHandles;
  494. procedure SetAccessList(const Value: TIdStrings);
  495. procedure SetActive(const Value: boolean);
  496. procedure SetTCPACLActive(const Value: boolean);
  497. procedure SetBindings(const Value: TIdSocketHandles);
  498. procedure TimeToUpdateNodeData(Sender : TObject);
  499. procedure InitComponent; override;
  500. public
  501. BackupDNSMap : TIdDNSMap;
  502. destructor Destroy; override;
  503. procedure CheckIfExpire(Sender: TObject);
  504. published
  505. property Active : boolean read FActive write SetActive;
  506. property AccessList : TIdStrings read FAccessList write SetAccessList;
  507. property Bindings: TIdSocketHandles read FBindings write SetBindings;
  508. property TCPACLActive : boolean read FTCPACLActive write SetTCPACLActive;
  509. property ServerType: TDNSServerTypes read FServerType write FServerType;
  510. property TCPTunnel : TIdDNS_TCPServer read FTCPTunnel write FTCPTunnel;
  511. property UDPTunnel : TIdDNS_UDPServer read FUDPTunnel write FUDPTunnel;
  512. end;
  513. // CompareItems is to compare TIdDNTreeNode
  514. function CompareItems(Item1, Item2: TObject): Integer;
  515. function FetchBytes(var AInput: TIdBytes; const ADelim: TIdBytes;
  516. const ADelete: Boolean = IdFetchDeleteDefault): TIdBytes;
  517. function PosBytes(const SubBytes, SBytes: TIdBytes): integer;
  518. function SameArray(const B1, B2: TIdBytes): boolean;
  519. implementation
  520. uses
  521. IdIOHandler, IdStack;
  522. {Common Utilities}
  523. function CompareItems(Item1, Item2: TObject): Integer;
  524. var LObj1, LObj2 : TIdDNTreeNode;
  525. begin
  526. LObj1 := Item1 as TIdDNTreeNode;
  527. LObj2 := Item2 as TIdDNTreeNode;
  528. Result := CompareText((LObj1 as TIdDNTreeNode).CLabel, (LObj2 as TIdDNTreeNode).CLabel);
  529. end;
  530. function SameArray(const B1, B2: TIdBytes): boolean;
  531. var
  532. i, l1: integer;
  533. begin
  534. Result := False;
  535. l1 := Length(B1);
  536. if l1 <> Length(B2) then
  537. Exit; //Different length
  538. for i := 0 to l1 - 1 do
  539. begin
  540. if B1[i] <> B2[i] then
  541. Exit;
  542. end;
  543. Result := True;
  544. end;
  545. function PosBytes(const SubBytes, SBytes: TIdBytes): integer;
  546. var
  547. i, l: integer;
  548. begin
  549. Result := -1;
  550. l := Length(SubBytes);
  551. for i := 0 to Length(SBytes) - l do
  552. begin
  553. if SameArray(SubBytes, copy(SBytes, i, l)) then
  554. begin
  555. Result := i;
  556. Exit;
  557. end;
  558. end;
  559. end;
  560. function FetchBytes(var AInput: TIdBytes; const ADelim: TIdBytes;
  561. const ADelete: Boolean = IdFetchDeleteDefault): TIdBytes;
  562. var
  563. LPos: integer;
  564. begin
  565. LPos := PosBytes(ADelim, AInput);
  566. if LPos = -1 then begin
  567. Result := AInput;
  568. if ADelete then begin
  569. SetLength(AInput, 0);
  570. end;
  571. end
  572. else begin
  573. Result := Copy(AInput, 0, LPos);
  574. if ADelete then begin
  575. //slower Delete(AInput, 1, LPos + Length(ADelim) - 1);
  576. AInput:=Copy(AInput, LPos + Length(ADelim), MaxInt);
  577. end;
  578. end;
  579. end;
  580. { TIdMWayTreeNode }
  581. function TIdMWayTreeNode.AddChild: TIdMWayTreeNode;
  582. begin
  583. Result := Self.FundmentalClass.Create(FundmentalClass);
  584. Self.SubTree.Add(Result);
  585. end;
  586. constructor TIdMWayTreeNode.Create(NodeClass : TIdMWayTreeNodeClass);
  587. begin
  588. inherited Create;
  589. Self.FundmentalClass := NodeClass;
  590. Self.SubTree := TIdObjectList.Create;
  591. end;
  592. destructor TIdMWayTreeNode.Destroy;
  593. begin
  594. SubTree.Free;
  595. inherited;
  596. end;
  597. function TIdMWayTreeNode.GetTreeNode(Index: integer): TIdMWayTreeNode;
  598. begin
  599. Result := TIdMWayTreeNode(Self.SubTree.Items[Index]);
  600. end;
  601. function TIdMWayTreeNode.InsertChild(Index: integer): TIdMWayTreeNode;
  602. begin
  603. Result := Self.FundmentalClass.Create(FundmentalClass);
  604. Self.SubTree.Insert(Index, Result);
  605. end;
  606. procedure TIdMWayTreeNode.RemoveChild(Index: integer);
  607. begin
  608. Self.SubTree.Remove(SubTree.Items[Index]);
  609. end;
  610. procedure TIdMWayTreeNode.SetFundmentalClass(
  611. const Value: TIdMWayTreeNodeClass);
  612. begin
  613. FFundmentalClass := Value;
  614. end;
  615. procedure TIdMWayTreeNode.SetTreeNode(Index: integer;
  616. const Value: TIdMWayTreeNode);
  617. begin
  618. Self.SubTree.Items[Index] := Value;
  619. end;
  620. { TIdDNTreeNode }
  621. function TIdDNTreeNode.AddChild: TIdDNTreeNode;
  622. begin
  623. Result := TIdDNTreeNode.Create(Self);
  624. Self.SubTree.Add(Result);
  625. end;
  626. procedure TIdDNTreeNode.Clear;
  627. var
  628. Stop, Start : integer;
  629. begin
  630. Start := Self.SubTree.Count - 1;
  631. for Stop := Start downto 0 do begin
  632. Self.RemoveChild(Stop);
  633. end;
  634. end;
  635. function TIdDNTreeNode.ConvertToDNString: string;
  636. var
  637. Count : integer;
  638. MyString, ChildString : string;
  639. begin
  640. ChildString := '';
  641. MyString := '';
  642. MyString := '$ORIGIN ' + Self.FullName + #13+#10; {do not localize}
  643. for Count := 0 to Self.RRs.Count -1 do begin
  644. MyString := MyString + Self.RRs.Items[Count].TextRecord(Self.FullName);
  645. end;
  646. for Count := 0 to Self.FChildIndex.Count -1 do begin
  647. ChildString := ChildString + Self.Children[Count].ConvertToDNString;
  648. end;
  649. Result := MyString + ChildString;
  650. end;
  651. constructor TIdDNTreeNode.Create(ParentNode : TIdDNTreeNode);
  652. begin
  653. Inherited Create(TIdDNTreeNode);
  654. Self.FRRs := TIdTextModeRRs.Create;
  655. Self.FChildIndex := TIdStringList.Create;
  656. Self.ParentNode := ParentNode;
  657. end;
  658. destructor TIdDNTreeNode.Destroy;
  659. begin
  660. Self.FRRs.Free;
  661. Self.FChildIndex.Free;
  662. inherited;
  663. end;
  664. function TIdDNTreeNode.DumpAllBinaryData(var RecordCount:integer): TIdBytes;
  665. var
  666. Count, ChildCount : integer;
  667. MyString, ChildString : TIdBytes;
  668. begin
  669. SetLength(ChildString, 0);
  670. SetLength(MyString, 0);
  671. RecordCount := RecordCount + Self.RRs.Count + 1;
  672. for Count := 0 to Self.RRs.Count -1 do
  673. begin
  674. AppendBytes(MyString, Self.RRs.Items[Count].BinQueryRecord(Self.FullName));
  675. end;
  676. for Count := 0 to Self.FChildIndex.Count -1 do
  677. begin
  678. AppendBytes(ChildString, Self.Children[Count].DumpAllBinaryData(ChildCount));
  679. RecordCount := RecordCount + ChildCount;
  680. end;
  681. if Self.RRs.Count > 0 then
  682. begin
  683. if (Self.RRs.Items[0] is TIdRR_SOA) then
  684. begin
  685. RecordCount := RecordCount + 1;
  686. AppendBytes(MyString, Self.RRs.Items[0].BinQueryRecord(Self.FullName));
  687. end;
  688. end;
  689. Result := MyString;
  690. AppendBytes(Result, ChildString);
  691. AppendBytes(Result, Self.RRs.Items[0].BinQueryRecord(Self.FullName));
  692. end;
  693. function TIdDNTreeNode.GetFullName: string;
  694. begin
  695. if Self.ParentNode = nil then
  696. if Self.CLabel = '.' then
  697. Result := ''
  698. else
  699. Result := Self.CLabel
  700. else
  701. Result := Self.CLabel + '.' +Self.ParentNode.FullName;
  702. end;
  703. function TIdDNTreeNode.GetNode(Index: integer): TIdDNTreeNode;
  704. begin
  705. Result := TIdDNTreeNode(Self.SubTree.Items[Index]);
  706. end;
  707. function TIdDNTreeNode.IndexByLabel(CLabel: AnsiString): integer;
  708. begin
  709. Result := Self.FChildIndex.IndexOf(CLabel);
  710. end;
  711. function TIdDNTreeNode.IndexByNode(ANode: TIdDNTreeNode): integer;
  712. begin
  713. Result := Self.SubTree.IndexOf(ANode);
  714. end;
  715. function TIdDNTreeNode.InsertChild(Index: integer): TIdDNTreeNode;
  716. begin
  717. Result := TIdDNTreeNode.Create(Self);
  718. Self.SubTree.Insert(Index, Result);
  719. end;
  720. procedure TIdDNTreeNode.RemoveChild(Index: integer);
  721. begin
  722. Self.SubTree.Remove(Self.SubTree.Items[Index]);
  723. Self.FChildIndex.Delete(Index);
  724. end;
  725. procedure TIdDNTreeNode.SaveToFile(Filename: TFilename);
  726. var
  727. DNSs : TIdStrings;
  728. begin
  729. DNSs := TIdStringList.Create;
  730. try
  731. DNSs.Add(Self.ConvertToDNString);
  732. DNSs.SaveToFile(Filename);
  733. finally
  734. DNSs.Free;
  735. end;
  736. end;
  737. procedure TIdDNTreeNode.SetChildIndex(const Value: TStrings);
  738. begin
  739. Self.FChildIndex.Assign(Value);
  740. end;
  741. procedure TIdDNTreeNode.SetCLabel(const Value: AnsiString);
  742. begin
  743. FCLabel := Value;
  744. if Self.ParentNode <> nil then
  745. Self.ParentNode.ChildIndex.Insert(ParentNode.SubTree.IndexOf(Self), Value);
  746. if Self.AutoSortChild then Self.SortChildren;
  747. end;
  748. procedure TIdDNTreeNode.SetNode(Index: integer;
  749. const Value: TIdDNTreeNode);
  750. begin
  751. Self.SubTree.Items[Index] := Value;
  752. end;
  753. procedure TIdDNTreeNode.SetRRs(const Value: TIdTextModeRRs);
  754. begin
  755. FRRs.Assign(Value);
  756. end;
  757. procedure TIdDNTreeNode.SortChildren;
  758. begin
  759. Self.SubTree.BubbleSort(CompareItems);
  760. TStringList(Self.FChildIndex).Sort;
  761. end;
  762. { TIdDNSServer }
  763. function TIdDNS_UDPServer.CompleteQuery(DNSHeader : TDNSHeader; Question: string;
  764. OriginalQuestion: TIdBytes; var Answer: TIdBytes; QType, QClass: word;
  765. DNSResolver : TIdDNSResolver): string;
  766. var
  767. IsMyDomains : boolean;
  768. lAnswer: TIdBytes;
  769. WildQuestion, TempDomain : string;
  770. begin
  771. // QClass = 1 => IN, we support only "IN" class now.
  772. // QClass = 2 => CS,
  773. // QClass = 3 => CH,
  774. // QClass = 4 => HS.
  775. TempDomain := IndyLowerCase(Question);
  776. IsMyDomains := (Self.Handed_DomainList.IndexOf(TempDomain) > -1);
  777. if not IsMyDomains then
  778. begin
  779. Fetch(TempDomain, '.');
  780. end;
  781. IsMyDomains := (Self.Handed_DomainList.IndexOf(TempDomain) > -1);
  782. if (QClass = 1) then begin
  783. if IsMyDomains then begin
  784. Self.InternalSearch(DNSHeader, Question, QType, lAnswer, True, False, False);
  785. Answer := lAnswer;
  786. if ((QType = TypeCode_A) or (QType = TypeCode_AAAA)) and
  787. (Length(Answer) = 0) then begin
  788. Self.InternalSearch(DNSHeader, Question, TypeCode_CNAME, lAnswer, True, False, True);
  789. AppendBytes(Answer, lAnswer);
  790. end;
  791. //if lAnswer = '' then begin
  792. WildQuestion := Question;
  793. fetch(WildQuestion, '.');
  794. WildQuestion := '*.' + WildQuestion;
  795. Self.InternalSearch(DNSHeader, WildQuestion, QType, lAnswer, True, False, False, true, Question);
  796. AppendBytes(Answer, lAnswer);
  797. //end;
  798. if Length(Answer) > 0 then
  799. Result := cRCodeQueryOK
  800. else Result := cRCodeQueryNotFound;
  801. end else begin
  802. Self.InternalSearch(DNSHeader, Question, QType, Answer, True, True, False);
  803. if ((QType = TypeCode_A) or (QType = TypeCode_AAAA)) and
  804. (Length(Answer) = 0) then begin
  805. Self.InternalSearch(DNSHeader, Question, TypeCode_CNAME, lAnswer, True, True, False);
  806. AppendBytes(Answer, lAnswer);
  807. end;
  808. if Length(Answer) > 0 then
  809. Result := cRCodeQueryCacheOK
  810. else begin
  811. QType := TypeCode_Error;
  812. Self.InternalSearch(DNSHeader, Question, QType, Answer, True, True, False);
  813. if BytesToString(Answer) = 'Error' then begin {do not localize}
  814. Result := cRCodeQueryCacheFindError;
  815. end else begin
  816. Self.ExternalSearch(DNSResolver, DNSHeader, OriginalQuestion, Answer);
  817. if Length(Answer) > 0 then
  818. Result := cRCodeQueryReturned
  819. else Result := cRCodeQueryNotImplement;
  820. end;
  821. end;
  822. end
  823. end else begin
  824. Result := cRCodeQueryNotImplement;
  825. end;
  826. end;
  827. procedure TIdDNS_UDPServer.InitComponent;
  828. begin
  829. inherited;
  830. Self.FRootDNS_NET := TIdStringList.Create;
  831. Self.FRootDNS_NET.Add('209.92.33.150'); // nic.net {do not localize}
  832. Self.FRootDNS_NET.Add('209.92.33.130'); // nic.net {do not localize}
  833. Self.FRootDNS_NET.Add('203.37.255.97'); // apnic.net {do not localize}
  834. Self.FRootDNS_NET.Add('202.12.29.131'); // apnic.net {do not localize}
  835. Self.FRootDNS_NET.Add('12.29.20.2'); // nanic.net {do not localize}
  836. Self.FRootDNS_NET.Add('204.145.119.2'); // nanic.net {do not localize}
  837. Self.FRootDNS_NET.Add('140.111.1.2'); // a.twnic.net.tw {do not localize}
  838. Self.FCached_Tree := TIdDNTreeNode.Create(nil);
  839. Self.FCached_Tree.AutoSortChild := True;
  840. Self.FCached_Tree.CLabel := '.';
  841. Self.FHanded_Tree := TIdDNTreeNode.Create(nil);
  842. Self.FHanded_Tree.AutoSortChild := True;
  843. Self.FHanded_Tree.CLabel := '.';
  844. Self.FHanded_DomainList := TIdStringList.Create;
  845. Self.FZoneMasterFiles := TIdStringList.Create;
  846. DefaultPort := IdPORT_DOMAIN;
  847. Self.FCS := TIdCriticalSection.Create;
  848. Self.FGlobalCS := TIdCriticalSection.Create;
  849. Self.FBusy := False;
  850. end;
  851. destructor TIdDNS_UDPServer.Destroy;
  852. begin
  853. Self.FCached_Tree.Free;
  854. Self.FHanded_Tree.Free;
  855. Self.FRootDNS_NET.Free;
  856. Self.FHanded_DomainList.Free;
  857. Self.FZoneMasterFiles.Free;
  858. Self.FCS.Free;
  859. Self.FGlobalCS.Free;
  860. inherited;
  861. end;
  862. procedure TIdDNS_UDPServer.DoAfterQuery(ABinding: TIdSocketHandle;
  863. ADNSHeader: TDNSHeader; var QueryResult: String; ResultCode : String;
  864. Query : string);
  865. begin
  866. if Assigned(FOnAfterQuery) then begin
  867. FOnAfterQuery(ABinding, ADNSHeader, QueryResult, ResultCode, Query);
  868. end;
  869. end;
  870. procedure TIdDNS_UDPServer.DoBeforeQuery(ABinding: TIdSocketHandle;
  871. ADNSHeader: TDNSHeader; var ADNSQuery: String);
  872. begin
  873. if Assigned(FOnBeforeQuery) then begin
  874. FOnBeforeQuery(ABinding, ADNSHeader, ADNSQuery);
  875. end;
  876. end;
  877. (*procedure TIdDNS_UDPServer.DoUDPRead(AData: TStream;
  878. ABinding: TIdSocketHandle);
  879. var
  880. ExternalQuery, QName, QLabel, Answer, RString, FinalResult : string;
  881. DNSHeader_Processing : TDNSHeader;
  882. QType, QClass : Word;
  883. QPos, QLength, LLength : integer;
  884. DNSResolver : TIdDNSResolver;
  885. begin
  886. inherited DoUDPRead(AData, ABinding);
  887. //Self.CS.Acquire;
  888. SetLength(ExternalQuery, AData.Size);
  889. AData.Read(ExternalQuery[1], AData.Size);
  890. FinalResult := '';
  891. if AData.Size >= 12 then begin
  892. DNSHeader_Processing := TDNSHeader.Create;
  893. DNSResolver := TIdDNSResolver.Create(Self);
  894. DNSResolver.WaitingTime := 10000;
  895. try
  896. if DNSHeader_Processing.ParseQuery(ExternalQuery) <> 0 then begin
  897. //FinalResult := ComposeErrorResult
  898. DoAfterQuery(ABinding, DNSHeader_Processing, FinalResult, RString, ExternalQuery)
  899. end else begin
  900. if DNSHeader_Processing.QDCount > 0 then begin
  901. QPos := 13;
  902. QLength := Length(ExternalQuery);
  903. if (QLength > 12) then begin
  904. QName := '';
  905. repeat
  906. Answer := '';
  907. LLength := Byte(ExternalQuery[QPos]);
  908. Inc(QPos);
  909. QLabel := Copy(ExternalQuery, QPos, LLength);
  910. Inc(QPos, LLength);
  911. if QName <> '' then
  912. QName := QName + QLabel + '.'
  913. else
  914. QName := QLabel + '.';
  915. until ((QPos >= QLength) or (ExternalQuery[QPos] = #0));
  916. //HD_QDPos := QPos;
  917. Inc(QPos);
  918. QType := TwoCharToWord(ExternalQuery[QPos], ExternalQuery[QPos + 1]);
  919. Inc(QPos, 2);
  920. QClass := TwoCharToWord(ExternalQuery[QPos], ExternalQuery[QPos + 1]);
  921. DoBeforeQuery(ABinding, DNSHeader_Processing, ExternalQuery);
  922. RString := Self.CompleteQuery(DNSHeader_Processing, QName, ExternalQuery, Answer, QType, QClass, DNSResolver);
  923. if RString = cRCodeQueryNotImplement then begin
  924. ComposeErrorResult(FinalResult, DNSHeader_Processing, ExternalQuery, iRCodeQueryNotImplement);
  925. end else begin
  926. if (RString = cRCodeQueryReturned) then
  927. FinalResult := Answer
  928. else begin
  929. if (RString = cRCodeQueryNotFound) then
  930. ComposeErrorResult(FinalResult, DNSHeader_Processing, ExternalQuery, iRCodeQueryNotFound)
  931. else
  932. FinalResult := CombineAnswer(DNSHeader_Processing, ExternalQuery, Answer);
  933. end;
  934. end;
  935. DoAfterQuery(ABinding, DNSHeader_Processing, FinalResult, RString, ExternalQuery);
  936. end;
  937. end;
  938. end;
  939. finally
  940. try
  941. //Self.SendBuffer(ABinding.PeerIP, ABinding.Port, FinalResult[1], length(FinalResult));
  942. with ABinding do begin
  943. SendTo(PeerIP, PeerPort, FinalResult[1], length(FinalResult));
  944. end;
  945. DoAfterSendBack(ABinding, DNSHeader_Processing, FinalResult, RString, ExternalQuery);
  946. if (((Self.CacheUnknowZone) and (RString = cRCodeQueryReturned)) or
  947. (RString = cRCodeQueryCacheOK)) then
  948. Self.SaveToCache(FinalResult);
  949. finally
  950. DNSResolver.Free;
  951. DNSHeader_Processing.Free;
  952. end;
  953. end;
  954. end;
  955. //Self.CS.Release;
  956. end;
  957. *)
  958. procedure TIdDNS_UDPServer.ExternalSearch(aDNSResolver : TIdDNSResolver;
  959. Header: TDNSHeader; Question: TIdBytes; var Answer: TIdBytes);
  960. var
  961. Server_Index : integer;
  962. MyDNSResolver : TIdDNSResolver;
  963. begin
  964. Server_Index := 0;
  965. if (aDNSResolver = nil) then
  966. begin
  967. MyDNSResolver := TIdDNSResolver.Create(Self);
  968. MyDNSResolver.WaitingTime := 5000;
  969. end else
  970. begin
  971. MyDNSResolver := aDNSResolver;
  972. end;
  973. repeat
  974. MyDNSResolver.Host := Self.RootDNS_NET.Strings[Server_Index];
  975. try
  976. MyDNSResolver.InternalQuery := Question;
  977. MyDNSResolver.Resolve('');
  978. Answer := MyDNSResolver.PlainTextResult;
  979. except
  980. // Todo: Create DNS server interal resolver error.
  981. on EIdDnsResolverError do
  982. begin
  983. //Empty Event, for user to custom the event handle.
  984. end;
  985. on EIdSocketError do
  986. begin
  987. end;
  988. else
  989. begin
  990. end;
  991. end;
  992. Inc(Server_Index);
  993. until ((Server_Index >= Self.RootDNS_NET.Count) or (Length(Answer) > 0));
  994. if (aDNSResolver = nil) then
  995. begin
  996. MyDNSResolver.Free
  997. end;
  998. end;
  999. function TIdDNS_UDPServer.FindHandedNodeByName(QName: String;
  1000. QType: Word): TIdDNTreeNode;
  1001. begin
  1002. Result := Self.SearchTree(Self.Handed_Tree, QName, QType);
  1003. end;
  1004. function TIdDNS_UDPServer.FindNodeFullName(Root: TIdDNTreeNode;
  1005. QName: String; QType : Word): string;
  1006. var
  1007. MyNode : TIdDNTreeNode;
  1008. begin
  1009. MyNode := Self.SearchTree(Root, QName, QType);
  1010. if MyNode = nil then Result := ''
  1011. else begin
  1012. Result := MyNode.FullName;
  1013. end;
  1014. end;
  1015. function TIdDNS_UDPServer.LoadZoneFromMasterFile(
  1016. MasterFileName: TFileName): boolean;
  1017. var
  1018. FileStrings : TIdStrings;
  1019. begin
  1020. {MakeTagList;}
  1021. Result := FileExists(MasterFileName);
  1022. if Result then begin
  1023. FileStrings := TIdStringList.Create;
  1024. FileStrings.LoadFromFile(MasterFileName);
  1025. Result := LoadZoneStrings(FileStrings, MasterFileName, Self.Handed_Tree);
  1026. {
  1027. Result := IsValidMasterFile;
  1028. // IsValidMasterFile is used in local, so I design with not
  1029. // any parameter.
  1030. if Result then begin
  1031. Result := LoadMasterFile;
  1032. end;
  1033. }
  1034. FileStrings.Free;
  1035. end;
  1036. {FreeTagList;}
  1037. end;
  1038. function TIdDNS_UDPServer.LoadZoneStrings(FileStrings: TIdStrings; Filename : TFilename;
  1039. TreeRoot : TIdDNTreeNode): boolean;
  1040. var
  1041. TagList : TIdStrings;
  1042. function IsMSDNSFileName(theFileName : TFilename; var DN:string) : boolean;
  1043. var
  1044. namepart : TIdStrings;
  1045. Fullname : string;
  1046. Count : integer;
  1047. begin
  1048. Fullname := theFilename;
  1049. repeat
  1050. if (Pos('\', Fullname) > 0) then fetch(Fullname, '\');
  1051. until (Pos('\', Fullname) = 0);
  1052. namepart := TIdStringList.Create;
  1053. repeat
  1054. namepart.Add(fetch(Fullname,'.'));
  1055. until Fullname = '';
  1056. Result := (namepart.Strings[namepart.Count -1] = 'dns'); {do not localize}
  1057. if Result then begin
  1058. Count := 0;
  1059. DN := namepart.Strings[Count];
  1060. repeat
  1061. Inc(Count);
  1062. if Count <= namepart.Count -2 then begin
  1063. DN := DN + '.' + namepart.Strings[Count];
  1064. end;
  1065. until Count >= namepart.Count -2;
  1066. end;
  1067. namepart.Free;
  1068. end;
  1069. procedure MakeTagList;
  1070. begin
  1071. TagList := TIdStringList.Create;
  1072. TagList.Add(cAAAA);
  1073. TagList.Add(cA);
  1074. TagList.Add(cNS);
  1075. TagList.Add(cMD);
  1076. TagList.Add(cMF);
  1077. TagList.Add(cCName);
  1078. TagList.Add(cSOA);
  1079. TagList.Add(cMB);
  1080. TagList.Add(cMG);
  1081. TagList.Add(cMR);
  1082. TagList.Add(cNULL);
  1083. TagList.Add(cWKS);
  1084. TagList.Add(cPTR);
  1085. TagList.Add(cHINFO);
  1086. TagList.Add(cMINFO);
  1087. TagList.Add(cMX);
  1088. TagList.Add(cTXT);
  1089. // The Following Tags are used in master file, but not Resource Record.
  1090. TagList.Add(cOrigin);
  1091. TagList.Add(cInclude);
  1092. //TagList.Add(cAt);
  1093. end;
  1094. procedure FreeTagList;
  1095. begin
  1096. TagList.Free;
  1097. end;
  1098. function ClearDoubleQutoa (Strs : TIdStrings): boolean;
  1099. var
  1100. SSCount : integer;
  1101. Mark : boolean;
  1102. begin
  1103. SSCount := 0;
  1104. Mark := False;
  1105. while (SSCount <= Strs.Count -1) do begin
  1106. repeat
  1107. if Pos('"', Strs.Strings[SSCount]) > 0 then begin
  1108. Mark := Mark xor (Pos('"', Strs.Strings[SSCount]) > 0);
  1109. Strs.Strings[SSCount] := ReplaceSpecString(Strs.Strings[SSCount], '"', '', False);
  1110. end;
  1111. until (Pos('"', Strs.Strings[SSCount]) = 0);
  1112. if not Mark then Inc(SSCount)
  1113. else begin
  1114. Strs.Strings[SSCount] := Strs.Strings[SSCount] + ' ' +
  1115. Strs.Strings[SSCount + 1];
  1116. Strs.Delete(SSCount + 1);
  1117. end;
  1118. end;
  1119. Result := not Mark;
  1120. end;
  1121. function IsValidMasterFile : boolean;
  1122. var
  1123. EachLinePart : TIdStrings;
  1124. CurrentLineNum, TagField, Count : integer;
  1125. LineData, DataBody, Comment, FPart, Tag : string;
  1126. denoted, Stop, PassQuota : boolean;
  1127. begin
  1128. EachLinePart := TIdStringList.Create;
  1129. CurrentLineNum := 0;
  1130. Stop := False;
  1131. // Check Denoted;
  1132. denoted := false;
  1133. if FileStrings.Count > 0 then begin
  1134. repeat
  1135. LineData := Trim(FileStrings.Strings[CurrentLineNum]);
  1136. DataBody := Fetch(LineData, ';');
  1137. Comment := LineData;
  1138. PassQuota := Pos('(', DataBody) = 0;
  1139. // Split each item into TIdStrings.
  1140. repeat
  1141. if not PassQuota then begin
  1142. Inc(CurrentLineNum);
  1143. LineData := Trim(FileStrings.Strings[CurrentLineNum]);
  1144. DataBody := DataBody + ' ' + Fetch(LineData, ';');
  1145. PassQuota := Pos(')', DataBody) > 0;
  1146. end;
  1147. until PassQuota or (CurrentLineNum > (FileStrings.Count -1));
  1148. Stop := not PassQuota;
  1149. if not Stop then begin
  1150. EachLinePart.Clear;
  1151. DataBody := ReplaceSpecString(DataBody, '(', '');
  1152. DataBody := ReplaceSpecString(DataBody, ')', '');
  1153. repeat
  1154. DataBody := Trim(DataBody);
  1155. FPart := Fetch(DataBody, #9);
  1156. repeat
  1157. FPart := Trim(FPart);
  1158. Tag := Fetch(FPart,' ');
  1159. if (Tag <> '') and (Tag <> '(') and (Tag <> ')') then
  1160. EachLinePart.Add(Tag);
  1161. until (FPart='');
  1162. until (DataBody= '');
  1163. if not denoted then begin
  1164. if EachLinePart.Count > 1 then
  1165. denoted := (EachLinePart.Strings[0] = cOrigin) or (EachLinePart.IndexOf(cSOA) <> -1)
  1166. else
  1167. denoted := False;
  1168. end;
  1169. // Check Syntax;
  1170. if not ( (EachLinePart.Count > 0) and
  1171. (EachLinePart.Strings[0] = cOrigin) ) then begin
  1172. if not denoted then begin
  1173. if EachLinePart.Count > 0 then
  1174. Stop := ((EachLinePart.Count > 0) and (EachLinePart.IndexOf(cSOA)= -1))
  1175. else Stop := False;
  1176. end else begin
  1177. //TagField := -1;
  1178. //FieldCount := 0;
  1179. // Search Tag Named 'IN';
  1180. TagField := EachLinePart.IndexOf('IN'); {do not localize}
  1181. if TagField = -1 then begin
  1182. Count := 0;
  1183. repeat
  1184. if EachLinePart.Count > 0 then
  1185. TagField := TagList.IndexOf(EachLinePart.Strings[Count]);
  1186. Inc(Count);
  1187. until (Count >= EachLinePart.Count -1) or (TagField <> -1);
  1188. if TagField <> -1 then TagField := Count;
  1189. end else begin
  1190. if TagList.IndexOf(EachLinePart.Strings[TagField + 1]) = -1 then
  1191. TagField := -1
  1192. else Inc(TagField);
  1193. end;
  1194. if TagField > -1 then begin
  1195. case TagList.IndexOf(EachLinePart.Strings[TagField]) of
  1196. // Check ip
  1197. TypeCode_A : Stop := not IsValidIP(EachLinePart.Strings[TagField + 1]);
  1198. // Check ip v6
  1199. 0 : Stop := not IsValidIPv6(EachLinePart.Strings[TagField + 1]);
  1200. // Check Domain Name
  1201. TypeCode_CName, TypeCode_NS, TypeCode_MR,
  1202. TypeCode_MD, TypeCode_MB, TypeCode_MG,
  1203. TypeCode_MF: Stop := not IsHostName(EachLinePart.Strings[TagField + 1]);
  1204. // Can be anything
  1205. TypeCode_TXT, TypeCode_NULL: Stop := False;
  1206. // Must be FQDN.
  1207. TypeCode_PTR: Stop := not IsFQDN(EachLinePart.Strings[TagField + 1]);
  1208. // HINFO should has 2 fields : CPU and OS. but TIdStrings
  1209. // is 0 base, so that we have to minus one
  1210. TypeCode_HINFO: begin
  1211. Stop := not (ClearDoubleQutoa(EachLinePart) and
  1212. (EachLinePart.Count - TagField-1 = 2));
  1213. end;
  1214. // Check RMailBX and EMailBX but TIdStrings
  1215. // is 0 base, so that we have to minus one
  1216. TypeCode_MINFO: begin
  1217. Stop := (EachLinePart.Count - TagField-1 <> 2);
  1218. if not Stop then begin
  1219. Stop := not (IsHostName(EachLinePart.Strings[TagField + 1]) and
  1220. IsHostName(EachLinePart.Strings[TagField + 2]));
  1221. end;
  1222. end;
  1223. // Check Pref(Numeric) and Exchange. but TIdStrings
  1224. // is 0 base, so that we have to minus one
  1225. TypeCode_MX: begin
  1226. Stop := (EachLinePart.Count - TagField-1 <> 2);
  1227. if not Stop then begin
  1228. Stop := not (IsNumeric(EachLinePart.Strings[TagField + 1]) and
  1229. IsHostName(EachLinePart.Strings[TagField + 2]));
  1230. end;
  1231. end;
  1232. // TIdStrings is 0 base, so that we have to minus one
  1233. TypeCode_SOA: begin
  1234. Stop := (EachLinePart.Count - TagField-1 <> 7);
  1235. if not Stop then begin
  1236. Stop := not (IsHostName(EachLinePart.Strings[TagField + 1]) and
  1237. IsHostName(EachLinePart.Strings[TagField + 2]) and
  1238. IsNumeric(EachLinePart.Strings[TagField + 3]) and
  1239. IsNumeric(EachLinePart.Strings[TagField + 4]) and
  1240. IsNumeric(EachLinePart.Strings[TagField + 5]) and
  1241. IsNumeric(EachLinePart.Strings[TagField + 6]) and
  1242. IsNumeric(EachLinePart.Strings[TagField + 7])
  1243. );
  1244. end;
  1245. end;
  1246. TypeCode_WKS: Stop := (EachLinePart.Count - TagField = 1);
  1247. end;
  1248. end else begin
  1249. if EachLinePart.Count > 0 then
  1250. Stop := True;
  1251. end;
  1252. end;
  1253. end;
  1254. end;
  1255. Inc(CurrentLineNum);
  1256. until (CurrentLineNum > (FileStrings.Count -1)) or Stop;
  1257. end;
  1258. Result := not Stop;
  1259. EachLinePart.Free;
  1260. end;
  1261. function LoadMasterFile : boolean;
  1262. var
  1263. Checks, EachLinePart, DenotedDomain : TIdStrings;
  1264. CurrentLineNum, FieldCount, TagField, Count, LastTTL : integer;
  1265. LineData, DataBody, Comment, FPart, Tag,
  1266. RName, LastDenotedDomain, LastTag, NewDomain, SingleHostName, PrevDNTag : string;
  1267. denoted, Stop, PassQuota, Found, canChangPrevDNTag : boolean;
  1268. LLRR_A : TIdRR_A;
  1269. LLRR_AAAA : TIdRR_AAAA;
  1270. LLRR_NS : TIdRR_NS;
  1271. LLRR_MB : TIdRR_MB;
  1272. LLRR_Name : TIdRR_CName;
  1273. LLRR_SOA : TIdRR_SOA;
  1274. LLRR_MG : TIdRR_MG;
  1275. LLRR_MR : TIdRR_MR;
  1276. LLRR_PTR : TIdRR_PTR;
  1277. LLRR_HINFO : TIdRR_HINFO;
  1278. LLRR_MINFO : TIdRR_MINFO;
  1279. LLRR_MX : TIdRR_MX;
  1280. LLRR_TXT : TIdRR_TXT;
  1281. begin
  1282. EachLinePart := TIdStringList.Create;
  1283. DenotedDomain := TIdStringList.Create;
  1284. CurrentLineNum := 0;
  1285. LastDenotedDomain := '';
  1286. LastTag := '';
  1287. NewDomain := '';
  1288. PrevDNTag := '';
  1289. Stop := False;
  1290. //canChangPrevDNTag := True;
  1291. if IsMSDNSFileName(FileName, LastDenotedDomain) then begin
  1292. //canChangPrevDNTag := False;
  1293. Filename := Uppercase (Filename);
  1294. end else LastDenotedDomain := '';
  1295. if FileStrings.Count > 0 then begin
  1296. repeat
  1297. LineData := Trim(FileStrings.Strings[CurrentLineNum]);
  1298. DataBody := Fetch(LineData, ';');
  1299. Comment := LineData;
  1300. PassQuota := Pos('(', DataBody) = 0;
  1301. // Split each item into TIdStrings.
  1302. repeat
  1303. if not PassQuota then begin
  1304. Inc(CurrentLineNum);
  1305. LineData := Trim(FileStrings.Strings[CurrentLineNum]);
  1306. DataBody := DataBody + ' ' + Fetch(LineData, ';');
  1307. PassQuota := Pos(')', DataBody) > 0;
  1308. end;
  1309. until PassQuota;
  1310. EachLinePart.Clear;
  1311. DataBody := ReplaceSpecString(DataBody, '(', '');
  1312. DataBody := ReplaceSpecString(DataBody, ')', '');
  1313. repeat
  1314. DataBody := Trim(DataBody);
  1315. FPart := Fetch(DataBody, #9);
  1316. repeat
  1317. FPart := Trim(FPart);
  1318. Tag := Fetch(FPart,' ');
  1319. if (TagList.IndexOf(Tag) = -1) and (Tag <> 'IN') then {do not localize}
  1320. Tag := IndyLowerCase(Tag);
  1321. if (Tag <> '') and (Tag <> '(') and (Tag <> ')') then
  1322. EachLinePart.Add((Tag));
  1323. until (FPart = '');
  1324. until (DataBody= '');
  1325. if EachLinePart.Count > 0 then begin
  1326. if (EachLinePart.Strings[0] = cOrigin) then begin
  1327. // One Domain is found.
  1328. NewDomain := EachLinePart.Strings[1];
  1329. if Copy(NewDomain, Length(NewDomain),1) = '.' then begin
  1330. LastDenotedDomain := NewDomain;
  1331. NewDomain := '';
  1332. end else begin
  1333. LastDenotedDomain := NewDomain + '.' + LastDenotedDomain;
  1334. NewDomain := '';
  1335. end;
  1336. end else begin
  1337. // Search RR Type Tag;
  1338. Count := 0;
  1339. TagField := -1;
  1340. repeat
  1341. Found := (TagList.IndexOf(EachLinePart.Strings[Count]) > -1);
  1342. if Found then TagField := Count;
  1343. Inc(Count)
  1344. until Found or (Count > EachLinePart.Count -1);
  1345. // To initialize LastTTL;
  1346. LastTTL := 86400;
  1347. if TagField > -1 then begin
  1348. case TagField of
  1349. 1 : if EachLinePart.Strings[0] <> 'IN' then begin {do not localize}
  1350. canChangPrevDNTag := True;
  1351. LastTag := EachLinePart.Strings[0];
  1352. if EachLinePart.Strings[TagField] <> 'SOA' then begin {do not localize}
  1353. PrevDNTag := '';
  1354. end else begin
  1355. LastTTL := StrToInt(EachLinePart.Strings[TagField + 6]);
  1356. end;
  1357. end else canChangPrevDNTag := False;
  1358. 2 : if EachLinePart.Strings[1] = 'IN' then begin {do not localize}
  1359. LastTag := EachLinePart.Strings[0];
  1360. canChangPrevDNTag := True;
  1361. if EachLinePart.Strings[TagField] <> 'SOA' then begin {do not localize}
  1362. PrevDNTag := '';
  1363. end else begin
  1364. LastTTL := StrToInt(EachLinePart.Strings[TagField + 6]);
  1365. end;
  1366. end else canChangPrevDNTag := False;
  1367. else begin
  1368. canChangPrevDNTag := False;
  1369. LastTTL := 86400;
  1370. end;
  1371. end;
  1372. //if (EachLinePart.Strings[0] = cAt) or (PrevDNTag = 'SOA') then
  1373. if (EachLinePart.Strings[0] = cAt) then
  1374. SingleHostName := LastDenotedDomain
  1375. else begin
  1376. if LastTag = cAt then LastTag := SingleHostName;
  1377. if Copy(LastTag, Length(LastTag), 1) <> '.' then
  1378. SingleHostName := LastTag + '.' + LastDenotedDomain
  1379. else
  1380. SingleHostName := LastTag;
  1381. end;
  1382. case TagList.IndexOf(EachLinePart.Strings[TagField]) of
  1383. // Check ip
  1384. TypeCode_A : begin
  1385. LLRR_A := TIdRR_A.Create;
  1386. LLRR_A.RRName := SingleHostName;
  1387. LLRR_A.Address := EachLinePart.Strings[TagField + 1];
  1388. LLRR_A.TTL := LastTTL;
  1389. UpdateTree(TreeRoot, LLRR_A);
  1390. if canChangPrevDNTag then PrevDNTag := 'A';
  1391. end;
  1392. // Check IPv6 ip address 10/29,2002
  1393. 0 : begin
  1394. LLRR_AAAA := TIdRR_AAAA.Create;
  1395. LLRR_AAAA.RRName := SingleHostName;
  1396. LLRR_AAAA.Address := ConvertToVaildv6IP(EachLinePart.Strings[TagField + 1]);
  1397. LLRR_AAAA.TTL := LastTTL;
  1398. UpdateTree(TreeRoot, LLRR_AAAA);
  1399. if canChangPrevDNTag then PrevDNTag := 'AAAA'; {do not localize}
  1400. end;
  1401. // Check Domain Name
  1402. TypeCode_CName: begin
  1403. LLRR_Name := TIdRR_CName.Create;
  1404. LLRR_Name.RRName := SingleHostName;
  1405. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1406. LLRR_Name.CName := EachLinePart.Strings[TagField + 1]
  1407. else
  1408. LLRR_Name.CName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1409. LLRR_Name.TTL := LastTTL;
  1410. UpdateTree(TreeRoot, LLRR_Name);
  1411. if canChangPrevDNTag then PrevDNTag := 'CNAME'; {do not localize}
  1412. end;
  1413. TypeCode_NS : begin
  1414. LLRR_NS := TIdRR_NS.Create;
  1415. LLRR_NS.RRName := SingleHostName;
  1416. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1417. LLRR_NS.NSDName := EachLinePart.Strings[TagField + 1]
  1418. else
  1419. LLRR_NS.NSDName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1420. LLRR_NS.TTL := LastTTL;
  1421. UpdateTree(TreeRoot, LLRR_NS);
  1422. if canChangPrevDNTag then PrevDNTag := 'NS'; {do not localize}
  1423. end;
  1424. TypeCode_MR : begin
  1425. LLRR_MR := TIdRR_MR.Create;
  1426. LLRR_MR.RRName := SingleHostName;
  1427. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1428. LLRR_MR.NewName := EachLinePart.Strings[TagField + 1]
  1429. else
  1430. LLRR_MR.NewName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1431. LLRR_MR.TTL := LastTTL;
  1432. UpdateTree(TreeRoot, LLRR_MR);
  1433. if canChangPrevDNTag then PrevDNTag := 'MR'; {do not localize}
  1434. end;
  1435. TypeCode_MD, TypeCode_MB,
  1436. TypeCode_MF : begin
  1437. LLRR_MB := TIdRR_MB.Create;
  1438. LLRR_MB.RRName := SingleHostName;
  1439. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1440. LLRR_MB.MADName := EachLinePart.Strings[TagField + 1]
  1441. else
  1442. LLRR_MB.MADName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1443. LLRR_MB.TTL := LastTTL;
  1444. UpdateTree(TreeRoot, LLRR_MB);
  1445. if canChangPrevDNTag then PrevDNTag := 'MF'; {do not localize}
  1446. end;
  1447. TypeCode_MG : begin
  1448. LLRR_MG := TIdRR_MG.Create;
  1449. LLRR_MG.RRName := SingleHostName;
  1450. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1451. LLRR_MG.MGMName := EachLinePart.Strings[TagField + 1]
  1452. else
  1453. LLRR_MG.MGMName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1454. LLRR_MG.TTL := LastTTL;
  1455. UpdateTree(TreeRoot, LLRR_MG);
  1456. if canChangPrevDNTag then PrevDNTag := 'MG'; {do not localize}
  1457. end;
  1458. // Can be anything
  1459. TypeCode_TXT, TypeCode_NULL: begin
  1460. LLRR_TXT := TIdRR_TXT.Create;
  1461. LLRR_TXT.RRName := SingleHostName;
  1462. LLRR_TXT.TXT := EachLinePart.Strings[TagField + 1];
  1463. LLRR_TXT.TTL := LastTTL;
  1464. UpdateTree(TreeRoot, LLRR_TXT);
  1465. if canChangPrevDNTag then PrevDNTag := 'TXT'; {do not localize}
  1466. end;
  1467. // Must be FQDN.
  1468. TypeCode_PTR: begin
  1469. LLRR_PTR := TIdRR_PTR.Create;
  1470. LLRR_PTR.RRName := SingleHostName;
  1471. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1472. LLRR_PTR.PTRDName := EachLinePart.Strings[TagField + 1]
  1473. else
  1474. LLRR_PTR.PTRDName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1475. LLRR_PTR.TTL := LastTTL;
  1476. UpdateTree(TreeRoot, LLRR_PTR);
  1477. if canChangPrevDNTag then PrevDNTag := 'PTR'; {do not localize}
  1478. end;
  1479. // HINFO should has 2 fields : CPU and OS. but TIdStrings
  1480. // is 0 base, so that we have to minus one
  1481. TypeCode_HINFO: begin
  1482. ClearDoubleQutoa(EachLinePart);
  1483. LLRR_HINFO := TIdRR_HINFO.Create;
  1484. LLRR_HINFO.RRName := SingleHostName;
  1485. LLRR_HINFO.CPU := EachLinePart.Strings[TagField + 1];
  1486. LLRR_HINFO.OS := EachLinePart.Strings[TagField + 2];
  1487. LLRR_HINFO.TTL := LastTTL;
  1488. UpdateTree(TreeRoot, LLRR_HINFO);
  1489. if canChangPrevDNTag then PrevDNTag := 'HINFO'; {do not localize}
  1490. end;
  1491. // Check RMailBX and EMailBX but TIdStrings
  1492. // is 0 base, so that we have to minus one
  1493. TypeCode_MINFO: begin
  1494. LLRR_MINFO := TIdRR_MINFO.Create;
  1495. LLRR_MINFO.RRName := SingleHostName;
  1496. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1497. LLRR_MINFO.Responsible_Mail := EachLinePart.Strings[TagField + 1]
  1498. else
  1499. LLRR_MINFO.Responsible_Mail := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1500. if Copy(EachLinePart.Strings[TagField + 2], Length(EachLinePart.Strings[TagField + 2]),1) = '.' then
  1501. LLRR_MINFO.ErrorHandle_Mail := EachLinePart.Strings[TagField + 2]
  1502. else
  1503. LLRR_MINFO.ErrorHandle_Mail := EachLinePart.Strings[TagField + 2] + '.' + LastDenotedDomain;
  1504. LLRR_MINFO.TTL := LastTTL;
  1505. UpdateTree(TreeRoot, LLRR_MINFO);
  1506. if canChangPrevDNTag then PrevDNTag := 'MINFO'; {do not localize}
  1507. end;
  1508. // Check Pref(Numeric) and Exchange. but TIdStrings
  1509. // is 0 base, so that we have to minus one
  1510. TypeCode_MX: begin
  1511. LLRR_MX := TIdRR_MX.Create;
  1512. LLRR_MX.RRName := SingleHostName;
  1513. LLRR_MX.Preference := EachLinePart.Strings[TagField + 1];
  1514. if Copy(EachLinePart.Strings[TagField + 2], Length(EachLinePart.Strings[TagField + 2]),1) = '.' then
  1515. LLRR_MX.Exchange := EachLinePart.Strings[TagField + 2]
  1516. else
  1517. LLRR_MX.Exchange := EachLinePart.Strings[TagField + 2] + '.' + LastDenotedDomain;
  1518. LLRR_MX.TTL := LastTTL;
  1519. UpdateTree(TreeRoot, LLRR_MX);
  1520. if canChangPrevDNTag then PrevDNTag := 'MX'; {do not localize}
  1521. end;
  1522. // TIdStrings is 0 base, so that we have to minus one
  1523. TypeCode_SOA: begin
  1524. LLRR_SOA := TIdRR_SOA.Create;
  1525. if Copy(EachLinePart.Strings[TagField + 1], Length(EachLinePart.Strings[TagField + 1]),1) = '.' then
  1526. LLRR_SOA.MName := EachLinePart.Strings[TagField + 1]
  1527. else
  1528. LLRR_SOA.MName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
  1529. //LLRR_SOA.RRName:= LLRR_SOA.MName;
  1530. if (SingleHostName = '') and (LastDenotedDomain = '') then begin
  1531. LastDenotedDomain := LLRR_SOA.MName;
  1532. Fetch(LastDenotedDomain, '.');
  1533. SingleHostName := LastDenotedDomain;
  1534. end;
  1535. LLRR_SOA.RRName := SingleHostName;
  1536. // Update the Handed List
  1537. {if Self.Handed_DomainList.IndexOf(LLRR_SOA.MName) = -1 then begin
  1538. Self.Handed_DomainList.Add(LLRR_SOA.MName);
  1539. end;
  1540. }
  1541. if Self.Handed_DomainList.IndexOf(LLRR_SOA.RRName) = -1 then begin
  1542. Self.Handed_DomainList.Add(LLRR_SOA.RRName);
  1543. end;
  1544. {if DenotedDomain.IndexOf(LLRR_SOA.MName) = -1 then
  1545. DenotedDomain.Add(LLRR_SOA.MName);
  1546. LastDenotedDomain := LLRR_SOA.MName;}
  1547. if DenotedDomain.IndexOf(LLRR_SOA.RRName) = -1 then
  1548. DenotedDomain.Add(LLRR_SOA.RRName);
  1549. //LastDenotedDomain := LLRR_SOA.RRName;
  1550. if Copy(EachLinePart.Strings[TagField + 2], Length(EachLinePart.Strings[TagField + 2]),1) = '.' then
  1551. LLRR_SOA.RName := EachLinePart.Strings[TagField + 2]
  1552. else
  1553. LLRR_SOA.RName := EachLinePart.Strings[TagField + 2] + '.' + LastDenotedDomain;
  1554. Checks := TIdStringList.Create;
  1555. RName := LLRR_SOA.RName;
  1556. while (RName <> '') do begin
  1557. Checks.Add(Fetch(RName, '.'));
  1558. end;
  1559. RName := '';
  1560. For Count := 0 to Checks.Count -1 do begin
  1561. if Checks.Strings[Count] <> '' then
  1562. RName := RName + Checks.Strings[Count] + '.';
  1563. end;
  1564. LLRR_SOA.RName := RName;
  1565. Checks.Free;
  1566. LLRR_SOA.Serial :=EachLinePart.Strings[TagField + 3];
  1567. LLRR_SOA.Refresh := EachLinePart.Strings[TagField + 4];
  1568. LLRR_SOA.Retry := EachLinePart.Strings[TagField + 5];
  1569. LLRR_SOA.Expire := EachLinePart.Strings[TagField + 6];
  1570. LLRR_SOA.Minimum := EachLinePart.Strings[TagField + 7];
  1571. LastTTL := StrToInt(LLRR_SOA.Expire);
  1572. LLRR_SOA.TTL := LastTTL;
  1573. UpdateTree(TreeRoot, LLRR_SOA);
  1574. if canChangPrevDNTag then PrevDNTag := 'SOA'; {do not localize}
  1575. end;
  1576. TypeCode_WKS: begin
  1577. if canChangPrevDNTag then PrevDNTag := 'WKS'; {do not localize}
  1578. end;
  1579. end;
  1580. end;
  1581. end; // if EachLinePart.Count == 0 => Only Comment
  1582. end;
  1583. Inc(CurrentLineNum);
  1584. until (CurrentLineNum > (FileStrings.Count -1));
  1585. end;
  1586. Result := not Stop;
  1587. EachLinePart.Free;
  1588. end;
  1589. begin
  1590. MakeTagList;
  1591. //if Result then begin
  1592. Result := IsValidMasterFile;
  1593. // IsValidMasterFile is used in local, so I design with not
  1594. // any parameter.
  1595. if Result then begin
  1596. Result := LoadMasterFile;
  1597. end;
  1598. //end;
  1599. FreeTagList;
  1600. end;
  1601. procedure TIdDNS_UDPServer.SaveToCache(ResourceRecord: string;
  1602. QueryName : string; OriginalQType : Word);
  1603. var
  1604. TempResolver : TIdDNSResolver;
  1605. count : integer;
  1606. //QType : Word;
  1607. RR : TResultRecord;
  1608. begin
  1609. TempResolver := TIdDNSResolver.Create(nil);
  1610. TempResolver.FillResultWithOutCheckId(ResourceRecord);
  1611. if TempResolver.FDNSHeader.ANCount > 0 then begin
  1612. for count := 0 to TempResolver.QueryResult.Count - 1 do begin
  1613. RR := TempResolver.QueryResult.Items[Count];
  1614. { marked by Dennies Chang. 2004/7/16
  1615. case RR.RecType of
  1616. qtA : QType := TypeCode_A;
  1617. qtAAAA : QType := TypeCode_AAAA;
  1618. qtNS: QType := TypeCode_NS;
  1619. qtMD: QType := TypeCode_MD;
  1620. qtMF: QType := TypeCode_MF;
  1621. qtName:QType := TypeCode_CName;
  1622. qtSOA: QType := TypeCode_SOA;
  1623. qtMB: QType := TypeCode_MB;
  1624. qtMG: QType := TypeCode_MG;
  1625. qtMR: QType := TypeCode_MR;
  1626. qtNull:QType := TypeCode_Null;
  1627. qtWKS:QType := TypeCode_WKS;
  1628. qtPTR:QType := TypeCode_PTR;
  1629. qtHINFO:QType := TypeCode_HINFO;
  1630. qtMINFO:QType := TypeCode_MINFO;
  1631. qtMX: QType := TypeCode_MX;
  1632. qtTXT: QType := TypeCode_TXT;
  1633. qtSTAR: QType := TypeCode_STAR;
  1634. else QType := TypeCode_STAR;
  1635. end;
  1636. }
  1637. UpdateTree(Self.Cached_Tree, RR);
  1638. end;
  1639. end;
  1640. TempResolver.Free;
  1641. end;
  1642. function TIdDNS_UDPServer.SearchTree(Root: TIdDNTreeNode;
  1643. QName: String; QType : Word): TIdDNTreeNode;
  1644. var
  1645. RRIndex : integer;
  1646. NodeCursor : TIdDNTreeNode;
  1647. NameLabels : TIdStrings;
  1648. OneNode, FullName : string;
  1649. Found : Boolean;
  1650. begin
  1651. Result := nil;
  1652. NameLabels := TIdStringList.Create;
  1653. FullName := QName;
  1654. NodeCursor := Root;
  1655. Found := False;
  1656. repeat
  1657. OneNode := Fetch(FullName, '.');
  1658. if OneNode <> '' then
  1659. NameLabels.Add(OneNode);
  1660. until FullName = '';
  1661. repeat
  1662. //if (QType = TypeCode_A) or (QType = TypeCode_PTR) then begin
  1663. if not (QType = TypeCode_SOA) then begin
  1664. RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
  1665. if RRIndex <> -1 then begin
  1666. NameLabels.Delete(NameLabels.Count - 1);
  1667. NodeCursor := NodeCursor.Children[RRIndex];
  1668. if NameLabels.Count = 1 then begin
  1669. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  1670. {
  1671. if not Found then begin
  1672. Found := (NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[0]) <> -1);
  1673. if not Found then NameLabels.Clear;
  1674. end
  1675. }
  1676. end else begin
  1677. Found := (NameLabels.Count = 0);
  1678. end;
  1679. end else begin
  1680. if NameLabels.Count = 1 then begin
  1681. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  1682. if not Found then NameLabels.Clear;
  1683. end else begin
  1684. NameLabels.Clear;
  1685. end;
  1686. end;
  1687. end else begin
  1688. RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
  1689. if RRIndex <> -1 then begin
  1690. NameLabels.Delete(NameLabels.Count - 1);
  1691. NodeCursor := NodeCursor.Children[RRIndex];
  1692. if NameLabels.Count = 1 then begin
  1693. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  1694. {
  1695. if not Found then begin
  1696. Found := (NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[0]) <> -1);
  1697. if not Found then NameLabels.Clear;
  1698. end
  1699. }
  1700. end else begin
  1701. Found := (NameLabels.Count = 0);
  1702. end;
  1703. end else begin
  1704. if NameLabels.Count = 1 then begin
  1705. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  1706. if not Found then NameLabels.Clear;
  1707. end else begin
  1708. NameLabels.Clear;
  1709. end;
  1710. end;
  1711. {
  1712. RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
  1713. if RRIndex <> -1 then begin
  1714. NameLabels.Delete(NameLabels.Count - 1);
  1715. Found := (NameLabels.Count = 0);
  1716. if NodeCursor.Children[RRIndex] <> nil then
  1717. NodeCursor := NodeCursor.Children[RRIndex];
  1718. end else begin
  1719. if NameLabels.Count = 1 then begin
  1720. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  1721. if not Found then NameLabels.Clear;
  1722. end else begin
  1723. NameLabels.Clear;
  1724. end;
  1725. end;
  1726. }
  1727. end;
  1728. until (NameLabels.Count = 0) or (Found);
  1729. if Found then Result := NodeCursor;
  1730. NameLabels.Free;
  1731. end;
  1732. {
  1733. procedure TIdDNS_UDPServer.SetCached_Tree(const Value: TIdDNTreeNode);
  1734. begin
  1735. FCached_Tree.Assign(Value);
  1736. end;
  1737. }
  1738. procedure TIdDNS_UDPServer.SetHanded_DomainList(const Value: TIdStrings);
  1739. begin
  1740. FHanded_DomainList.Assign(Value);
  1741. end;
  1742. {
  1743. procedure TIdDNS_UDPServer.SetHanded_Tree(const Value: TIdDNTreeNode);
  1744. begin
  1745. FHanded_Tree.Assign(Value);
  1746. end;
  1747. }
  1748. procedure TIdDNS_UDPServer.SetRootDNS_NET(const Value: TIdStrings);
  1749. begin
  1750. FRootDNS_NET.Assign(Value);
  1751. end;
  1752. procedure TIdDNS_UDPServer.SetZoneMasterFiles(const Value: TIdStrings);
  1753. begin
  1754. FZoneMasterFiles.Assign(Value);
  1755. end;
  1756. procedure TIdDNS_UDPServer.UpdateTree(TreeRoot: TIdDNTreeNode;
  1757. RR: TResultRecord);
  1758. var
  1759. NameNode : TIdStrings;
  1760. RRName, APart : String;
  1761. Count, NodeIndex : integer;
  1762. NodeCursor : TIdDNTreeNode;
  1763. LRR_A : TIdRR_A;
  1764. LRR_AAAA : TIdRR_AAAA;
  1765. LRR_NS : TIdRR_NS;
  1766. LRR_MB : TIdRR_MB;
  1767. LRR_Name : TIdRR_CName;
  1768. LRR_SOA : TIdRR_SOA;
  1769. LRR_MG : TIdRR_MG;
  1770. LRR_MR : TIdRR_MR;
  1771. LRR_PTR : TIdRR_PTR;
  1772. LRR_HINFO : TIdRR_HINFO;
  1773. LRR_MINFO : TIdRR_MINFO;
  1774. LRR_MX : TIdRR_MX;
  1775. LRR_TXT : TIdRR_TXT;
  1776. begin
  1777. RRName := RR.Name;
  1778. NameNode := TIdStringList.Create;
  1779. repeat
  1780. APart := Fetch(RRName, '.');
  1781. if APart <> '' then NameNode.Add(APart);
  1782. until RRName = '';
  1783. NodeCursor := TreeRoot;
  1784. RRName := RR.Name;
  1785. if Copy(RRName, Length(RRName), 1) <> '.' then RRName := RRName + '.';
  1786. //if not (RR.RecType = qtSOA) then begin
  1787. if (not (RR.RecType = qtSOA)) and (Self.Handed_DomainList.IndexOf(UpperCase(RR.Name)) = -1) then begin
  1788. For Count := NameNode.Count-1 downto 1 do begin
  1789. NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
  1790. if NodeIndex = -1 then begin
  1791. NodeCursor := NodeCursor.AddChild;
  1792. NodeCursor.AutoSortChild := True;
  1793. NodeCursor.CLabel := NameNode.Strings[Count];
  1794. end else begin
  1795. NodeCursor := NodeCursor.Children[NodeIndex];
  1796. end;
  1797. end;
  1798. RRName := NameNode.Strings[0];
  1799. end else begin
  1800. For Count := NameNode.Count-1 downto 0 do begin
  1801. NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
  1802. RRName := NameNode.Strings[Count];
  1803. if NodeIndex = -1 then begin
  1804. NodeCursor := NodeCursor.AddChild;
  1805. //NodeCursor.CLabel := RRName;
  1806. NodeCursor.AutoSortChild := True;
  1807. NodeCursor.CLabel := RRName;
  1808. end else begin
  1809. NodeCursor := NodeCursor.Children[NodeIndex];
  1810. end;
  1811. end;
  1812. RRName := RR.Name;
  1813. end;
  1814. NodeCursor.RRs.ItemNames.Add(RRName);
  1815. case RR.RecType of
  1816. qtA : begin
  1817. LRR_A := TIdRR_A.Create;
  1818. NodeCursor.RRs.Add(LRR_A);
  1819. LRR_A.RRName := RRName;
  1820. LRR_A.Address := TARecord(RR).IPAddress;
  1821. LRR_A.TTL := TARecord(RR).TTL;
  1822. if LRR_A.ifAddFullName(NodeCursor.FullName) then begin
  1823. LRR_A.RRName := LRR_A.RRName + '.'+ NodeCursor.FullName;
  1824. end;
  1825. end;
  1826. qtAAAA : begin
  1827. LRR_AAAA := TIdRR_AAAA.Create;
  1828. NodeCursor.RRs.Add(LRR_AAAA);
  1829. LRR_AAAA.RRName := RRName;
  1830. LRR_AAAA.Address := TAAAARecord(RR).Address;
  1831. LRR_AAAA.TTL := TAAAARecord(RR).TTL;
  1832. if LRR_AAAA.ifAddFullName(NodeCursor.FullName) then begin
  1833. LRR_AAAA.RRName := LRR_AAAA.RRName + '.'+ NodeCursor.FullName;
  1834. end;
  1835. end;
  1836. qtNS: begin
  1837. LRR_NS := TIdRR_NS.Create;
  1838. NodeCursor.RRs.Add(LRR_NS);
  1839. LRR_NS.RRName := RRName;
  1840. LRR_NS.NSDName := TNSRecord(RR).HostName;
  1841. LRR_NS.TTL := TNSRecord(RR).TTL;
  1842. if LRR_NS.ifAddFullName(NodeCursor.FullName) then begin
  1843. LRR_NS.RRName := LRR_NS.RRName + '.'+ NodeCursor.FullName;
  1844. end;
  1845. end;
  1846. qtMD,
  1847. qtMF,
  1848. qtMB: begin
  1849. LRR_MB := TIdRR_MB.Create;
  1850. NodeCursor.RRs.Add(LRR_MB);
  1851. LRR_MB.RRName := RRName;
  1852. LRR_MB.MADName := TNAMERecord(RR).HostName;
  1853. LRR_MB.TTL := TNAMERecord(RR).TTL;
  1854. if LRR_MB.ifAddFullName(NodeCursor.FullName) then begin
  1855. LRR_MB.RRName := LRR_MB.RRName + '.'+ NodeCursor.FullName;
  1856. end;
  1857. end;
  1858. qtName: begin
  1859. LRR_Name := TIdRR_CName.Create;
  1860. NodeCursor.RRs.Add(LRR_Name);
  1861. LRR_Name.RRName := RRName;
  1862. LRR_Name.CName := TNAMERecord(RR).HostName;
  1863. LRR_Name.TTL:= TNAMERecord(RR).TTL;
  1864. if LRR_Name.ifAddFullName(NodeCursor.FullName) then begin
  1865. LRR_Name.RRName := LRR_Name.RRName + '.'+ NodeCursor.FullName;
  1866. end;
  1867. end;
  1868. qtSOA: begin
  1869. LRR_SOA := TIdRR_SOA.Create;
  1870. NodeCursor.RRs.Add(LRR_SOA);
  1871. LRR_SOA.RRName := RRName;
  1872. LRR_SOA.MName := TSOARecord(RR).Primary;
  1873. LRR_SOA.RName := TSOARecord(RR).ResponsiblePerson;
  1874. LRR_SOA.Serial := IntToStr(TSOARecord(RR).Serial);
  1875. LRR_SOA.Minimum := IntToStr(TSOARecord(RR).MinimumTTL);
  1876. LRR_SOA.Refresh := IntToStr(TSOARecord(RR).Refresh);
  1877. LRR_SOA.Retry := IntToStr(TSOARecord(RR).Retry);
  1878. LRR_SOA.Expire := IntToStr(TSOARecord(RR).Expire);
  1879. LRR_SOA.TTL:= TSOARecord(RR).TTL;
  1880. if LRR_SOA.ifAddFullName(NodeCursor.FullName) then begin
  1881. LRR_SOA.RRName := LRR_SOA.RRName + '.'+ NodeCursor.FullName;
  1882. end else begin
  1883. if Copy(LRR_SOA.RRName, Length(LRR_SOA.RRName), 1) <> '.' then LRR_SOA.RRName := LRR_SOA.RRName + '.';
  1884. end;
  1885. end;
  1886. qtMG : begin
  1887. LRR_MG := TIdRR_MG.Create;
  1888. NodeCursor.RRs.Add(LRR_MG);
  1889. LRR_MG.RRName := RRName;
  1890. LRR_MG.MGMName := TNAMERecord(RR).HostName;
  1891. LRR_MG.TTL := TNAMERecord(RR).TTL;
  1892. if LRR_MG.ifAddFullName(NodeCursor.FullName) then begin
  1893. LRR_MG.RRName := LRR_MG.RRName + '.'+ NodeCursor.FullName;
  1894. end;
  1895. end;
  1896. qtMR : begin
  1897. LRR_MR := TIdRR_MR.Create;
  1898. NodeCursor.RRs.Add(LRR_MR);
  1899. LRR_MR.RRName := RRName;
  1900. LRR_MR.NewName := TNAMERecord(RR).HostName;
  1901. LRR_MR.TTL := TNAMERecord(RR).TTL;
  1902. if LRR_MR.ifAddFullName(NodeCursor.FullName) then begin
  1903. LRR_MR.RRName := LRR_MR.RRName + '.'+ NodeCursor.FullName;
  1904. end;
  1905. end;
  1906. qtWKS: begin
  1907. end;
  1908. qtPTR: begin
  1909. LRR_PTR := TIdRR_PTR.Create;
  1910. NodeCursor.RRs.Add(LRR_PTR);
  1911. LRR_PTR.RRName := RRName;
  1912. LRR_PTR.PTRDName := TPTRRecord(RR).HostName;
  1913. LRR_PTR.TTL := TPTRRecord(RR).TTL;
  1914. if LRR_PTR.ifAddFullName(NodeCursor.FullName) then begin
  1915. LRR_PTR.RRName := LRR_PTR.RRName + '.'+ NodeCursor.FullName;
  1916. end;
  1917. end;
  1918. qtHINFO: begin
  1919. LRR_HINFO := TIdRR_HINFO.Create;
  1920. NodeCursor.RRs.Add(LRR_HINFO);
  1921. LRR_HINFO.RRName := RRName;
  1922. LRR_HINFO.CPU := THINFORecord(RR).CPU;
  1923. LRR_HINFO.OS := THINFORecord(RR).OS;
  1924. LRR_HINFO.TTL := THINFORecord(RR).TTL;
  1925. if LRR_HINFO.ifAddFullName(NodeCursor.FullName) then begin
  1926. LRR_HINFO.RRName := LRR_HINFO.RRName + '.'+ NodeCursor.FullName;
  1927. end;
  1928. end;
  1929. qtMINFO: begin
  1930. LRR_MINFO := TIdRR_MINFO.Create;
  1931. NodeCursor.RRs.Add(LRR_MINFO);
  1932. LRR_MINFO.RRName := RRName;
  1933. LRR_MINFO.Responsible_Mail := TMINFORecord(RR).ResponsiblePersonMailbox;
  1934. LRR_MINFO.ErrorHandle_Mail := TMINFORecord(RR).ErrorMailbox;
  1935. LRR_MINFO.TTL := TMINFORecord(RR).TTL;
  1936. if LRR_MINFO.ifAddFullName(NodeCursor.FullName) then begin
  1937. LRR_MINFO.RRName := LRR_MINFO.RRName + '.' + NodeCursor.FullName;
  1938. end;
  1939. end;
  1940. qtMX: begin
  1941. LRR_MX := TIdRR_MX.Create;
  1942. NodeCursor.RRs.Add(LRR_MX);
  1943. LRR_MX.RRName := RRName;
  1944. LRR_MX.Exchange := TMXRecord(RR).ExchangeServer;
  1945. LRR_MX.Preference := IntToStr(TMXRecord(RR).Preference);
  1946. LRR_MX.TTL := TMXRecord(RR).TTL;
  1947. if LRR_MX.ifAddFullName(NodeCursor.FullName) then begin
  1948. LRR_MX.RRName := LRR_MX.RRName + '.'+ NodeCursor.FullName;
  1949. end;
  1950. end;
  1951. qtTXT, qtNULL: begin
  1952. LRR_TXT := TIdRR_TXT.Create;
  1953. NodeCursor.RRs.Add(LRR_TXT);
  1954. LRR_TXT.RRName := RRName;
  1955. LRR_TXT.TXT := TTextRecord(RR).Text.Text;
  1956. LRR_TXT.TTL := TTextRecord(RR).TTL;
  1957. if LRR_TXT.ifAddFullName(NodeCursor.FullName) then begin
  1958. LRR_TXT.RRName := LRR_TXT.RRName + '.'+ NodeCursor.FullName;
  1959. end;
  1960. end;
  1961. {qtSTAR: begin
  1962. end;
  1963. }
  1964. end;
  1965. //end;
  1966. NameNode.Free;
  1967. end;
  1968. procedure TIdDNS_UDPServer.UpdateTree(TreeRoot: TIdDNTreeNode;
  1969. RR: TIdTextModeResourceRecord);
  1970. var
  1971. NameNode : TIdStrings;
  1972. RRName, APart : String;
  1973. Count, NodeIndex, RRIndex : integer;
  1974. NodeCursor : TIdDNTreeNode;
  1975. LRR_AAAA : TIdRR_AAAA;
  1976. LRR_A : TIdRR_A;
  1977. LRR_NS : TIdRR_NS;
  1978. LRR_MB : TIdRR_MB;
  1979. LRR_Name : TIdRR_CName;
  1980. LRR_SOA : TIdRR_SOA;
  1981. LRR_MG : TIdRR_MG;
  1982. LRR_MR : TIdRR_MR;
  1983. LRR_PTR : TIdRR_PTR;
  1984. LRR_HINFO : TIdRR_HINFO;
  1985. LRR_MINFO : TIdRR_MINFO;
  1986. LRR_MX : TIdRR_MX;
  1987. LRR_TXT : TIdRR_TXT;
  1988. LRR_Error : TIdRR_Error;
  1989. begin
  1990. RRName := RR.RRName;
  1991. NameNode := TIdStringList.Create;
  1992. repeat
  1993. APart := Fetch(RRName, '.');
  1994. if APart <> '' then NameNode.Add(APart);
  1995. until RRName = '';
  1996. NodeCursor := TreeRoot;
  1997. RRName := RR.RRName;
  1998. if Copy(RRName, Length(RRName), 1) <> '.' then RR.RRName := RR.RRName + '.';
  1999. // VC: in2002-02-24-1715, it just denoted TIdRR_A and TIdRR_PTR,
  2000. // but that make search a domain name RR becoming complex,
  2001. // therefor I replace it with all RRs but not TIdRR_SOA
  2002. // SOA should own independent node.
  2003. if (not (RR is TIdRR_SOA)) and (Self.Handed_DomainList.IndexOf(IndyLowerCase(RR.RRName)) = -1) then begin
  2004. For Count := NameNode.Count - 1 downto 1 do begin
  2005. NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
  2006. if NodeIndex = -1 then begin
  2007. NodeCursor := NodeCursor.AddChild;
  2008. NodeCursor.AutoSortChild := True;
  2009. NodeCursor.CLabel := NameNode.Strings[Count];
  2010. end else begin
  2011. NodeCursor := NodeCursor.Children[NodeIndex];
  2012. end;
  2013. end;
  2014. RRName := NameNode.Strings[0];
  2015. end else begin
  2016. For Count := NameNode.Count -1 downto 0 do begin
  2017. NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
  2018. RRName := NameNode.Strings[Count];
  2019. if NodeIndex = -1 then begin
  2020. NodeCursor := NodeCursor.AddChild;
  2021. NodeCursor.AutoSortChild := True;
  2022. NodeCursor.CLabel := RRName;
  2023. end else begin
  2024. NodeCursor := NodeCursor.Children[NodeIndex];
  2025. end;
  2026. end;
  2027. RRName := RR.RRName;
  2028. end;
  2029. RRIndex := NodeCursor.RRs.ItemNames.IndexOf(RRName);
  2030. if RRIndex = -1 then
  2031. NodeCursor.RRs.ItemNames.Add(RRName)
  2032. else begin
  2033. repeat
  2034. Inc(RRIndex);
  2035. if RRIndex > NodeCursor.RRs.ItemNames.Count -1 then begin
  2036. RRIndex := -1;
  2037. break;
  2038. end;
  2039. if NodeCursor.RRs.ItemNames.Strings[RRIndex] <> RRName then
  2040. break;
  2041. until RRIndex > NodeCursor.RRs.ItemNames.Count -1;
  2042. if RRIndex = -1 then
  2043. NodeCursor.RRs.ItemNames.Add(RRName)
  2044. else
  2045. NodeCursor.RRs.ItemNames.Insert(RRIndex, RRName);
  2046. end;
  2047. case RR.TypeCode of
  2048. TypeCode_Error : begin
  2049. LRR_Error := TIdRR_Error(RR);
  2050. if RRIndex = -1 then
  2051. NodeCursor.RRs.Add(LRR_Error)
  2052. else
  2053. NodeCursor.RRs.Insert(RRIndex, LRR_Error);
  2054. end;
  2055. TypeCode_A : begin
  2056. LRR_A := TIdRR_A(RR);
  2057. if RRIndex = -1 then
  2058. NodeCursor.RRs.Add(LRR_A)
  2059. else
  2060. NodeCursor.RRs.Insert(RRIndex, LRR_A);
  2061. end;
  2062. TypeCode_AAAA : begin
  2063. LRR_AAAA := TIdRR_AAAA(RR);
  2064. if RRIndex = -1 then
  2065. NodeCursor.RRs.Add(LRR_AAAA)
  2066. else
  2067. NodeCursor.RRs.Insert(RRIndex, LRR_AAAA);
  2068. end;
  2069. TypeCode_NS: begin
  2070. LRR_NS := TIdRR_NS(RR);
  2071. if RRIndex = -1 then
  2072. NodeCursor.RRs.Add(LRR_NS)
  2073. else
  2074. NodeCursor.RRs.Insert(RRIndex, LRR_NS);
  2075. end;
  2076. TypeCode_MF: begin
  2077. LRR_MB := TIdRR_MB(RR);
  2078. if RRIndex = -1 then
  2079. NodeCursor.RRs.Add(LRR_MB)
  2080. else
  2081. NodeCursor.RRs.Insert(RRIndex, LRR_MB);
  2082. end;
  2083. TypeCode_CName: begin
  2084. LRR_Name := TIdRR_CName(RR);
  2085. if RRIndex = -1 then
  2086. NodeCursor.RRs.Add(LRR_Name)
  2087. else
  2088. NodeCursor.RRs.Insert(RRIndex, LRR_Name);
  2089. end;
  2090. TypeCode_SOA: begin
  2091. LRR_SOA := TIdRR_SOA(RR);
  2092. if RRIndex = -1 then
  2093. NodeCursor.RRs.Add(LRR_SOA)
  2094. else
  2095. NodeCursor.RRs.Insert(RRIndex, LRR_SOA);
  2096. end;
  2097. TypeCode_MG : begin
  2098. LRR_MG := TIdRR_MG(RR);
  2099. if RRIndex = -1 then
  2100. NodeCursor.RRs.Add(LRR_MG)
  2101. else
  2102. NodeCursor.RRs.Insert(RRIndex, LRR_MG);
  2103. end;
  2104. TypeCode_MR : begin
  2105. LRR_MR := TIdRR_MR(RR);
  2106. if RRIndex = -1 then
  2107. NodeCursor.RRs.Add(LRR_MR)
  2108. else
  2109. NodeCursor.RRs.Insert(RRIndex, LRR_MR);
  2110. end;
  2111. TypeCode_WKS: begin
  2112. end;
  2113. TypeCode_PTR: begin
  2114. LRR_PTR := TIdRR_PTR(RR);
  2115. if RRIndex = -1 then
  2116. NodeCursor.RRs.Add(LRR_PTR)
  2117. else
  2118. NodeCursor.RRs.Insert(RRIndex, LRR_PTR);
  2119. end;
  2120. TypeCode_HINFO: begin
  2121. LRR_HINFO := TIdRR_HINFO(RR);
  2122. if RRIndex = -1 then
  2123. NodeCursor.RRs.Add(LRR_HINFO)
  2124. else
  2125. NodeCursor.RRs.Insert(RRIndex, LRR_HINFO);
  2126. end;
  2127. TypeCode_MINFO: begin
  2128. LRR_MINFO := TIdRR_MINFO(RR);
  2129. if RRIndex = -1 then
  2130. NodeCursor.RRs.Add(LRR_MINFO)
  2131. else
  2132. NodeCursor.RRs.Insert(RRIndex, LRR_MINFO);
  2133. end;
  2134. TypeCode_MX: begin
  2135. LRR_MX := TIdRR_MX(RR);
  2136. if RRIndex = -1 then
  2137. NodeCursor.RRs.Add(LRR_MX)
  2138. else
  2139. NodeCursor.RRs.Insert(RRIndex, LRR_MX);
  2140. end;
  2141. TypeCode_TXT, TypeCode_NULL: begin
  2142. LRR_TXT := TIdRR_TXT(RR);
  2143. if RRIndex = -1 then
  2144. NodeCursor.RRs.Add(LRR_TXT)
  2145. else
  2146. NodeCursor.RRs.Insert(RRIndex, LRR_TXT);
  2147. end;
  2148. {qtSTAR: begin
  2149. end;
  2150. }
  2151. end;
  2152. //end;
  2153. NameNode.Free;
  2154. end;
  2155. procedure TIdDNS_UDPServer.DoAfterSendBack(ABinding: TIdSocketHandle;
  2156. ADNSHeader: TDNSHeader; var QueryResult: String; ResultCode: String;
  2157. Query : string);
  2158. begin
  2159. if Assigned(FOnAfterSendBack) then begin
  2160. FOnAfterSendBack(ABinding, ADNSHeader, QueryResult, ResultCode, Query);
  2161. end;
  2162. end;
  2163. function TIdDNS_UDPServer.AXFR( Header : TDNSHeader; Question: string; var Answer: TIdBytes): string;
  2164. var
  2165. TargetNode : TIdDNTreeNode;
  2166. IsMyDomains : boolean;
  2167. RRcount : integer;
  2168. Temp: TIdBytes;
  2169. begin
  2170. Question := IndyLowerCase(Question);
  2171. IsMyDomains := (Self.Handed_DomainList.IndexOf(Question) > -1);
  2172. if not IsMyDomains then begin
  2173. Fetch(Question, '.');
  2174. IsMyDomains := (Self.Handed_DomainList.IndexOf(Question) > -1);
  2175. end;
  2176. // Is my domain, go for searching the node.
  2177. TargetNode := nil;
  2178. SetLength(Answer, 0);
  2179. Header.ANCount := 0;
  2180. if IsMyDomains then TargetNode := SearchTree(Self.Handed_Tree, Question, TypeCode_SOA);
  2181. if IsMyDomains and (TargetNode <> nil) then begin
  2182. // combine the AXFR Data(So many)
  2183. RRCount := 0;
  2184. Answer := TargetNode.DumpAllBinaryData(RRCount);
  2185. Header.ANCount := RRCount;
  2186. Header.QR := iQr_Answer;
  2187. Header.AA := iAA_Authoritative;
  2188. Header.RCode := iRCodeNoError;
  2189. Header.QDCount := 0;
  2190. Header.ARCount := 0;
  2191. Header.TC := 0;
  2192. Temp := Header.GenerateBinaryHeader;
  2193. AppendBytes(Temp, Answer);
  2194. Answer := Temp;
  2195. Result := cRCodeQueryOK;
  2196. end else begin
  2197. Header.QR := iQr_Answer;
  2198. Header.AA := iAA_Authoritative;
  2199. Header.RCode := iRCodeNameError;
  2200. Header.QDCount := 0;
  2201. Header.ARCount := 0;
  2202. Header.TC := 0;
  2203. Answer := Header.GenerateBinaryHeader;
  2204. Result := cRCodeQueryNotFound;
  2205. end;
  2206. end;
  2207. procedure TIdDNS_UDPServer.InternalSearch(Header: TDNSHeader; QName: string;
  2208. QType : Word; var Answer: TIdBytes; IfMainQuestion : boolean;
  2209. IsSearchCache : boolean = false; IsAdditional : boolean = false;
  2210. IsWildCard : boolean = false; WildCardOrgName : string = '');
  2211. var
  2212. MoreAddrSearch : TIdStrings;
  2213. TargetNode : TIdDNTreeNode;
  2214. Server_Index, RRIndex, Count : integer;
  2215. LocalAnswer, TempBytes, TempAnswer: TIdBytes;
  2216. temp_QName, temp: string;
  2217. AResult: TIdBytes;
  2218. Stop, Extra, IsMyDomains, ifAdditional : boolean;
  2219. LDNSResolver : TIdDNSResolver;
  2220. TM1, TM2 : TTimeStamp;
  2221. begin
  2222. SetLength(Answer, 0);
  2223. SetLength(Aresult, 0);
  2224. // Search the Handed Tree first.
  2225. MoreAddrSearch := TIdStringList.Create;
  2226. Extra := False;
  2227. //Pushed := False;
  2228. if not IsSearchCache then begin
  2229. TargetNode := SearchTree(Self.Handed_Tree, QName, QType);
  2230. if TargetNode <> nil then begin //Assemble the Answer.
  2231. RRIndex := TargetNode.RRs.ItemNames.IndexOf(IndyLowerCase(QName));
  2232. if RRIndex = -1 then begin
  2233. { below are added again by Dennies Chang in 2004/7/15
  2234. { According RFC 1035, a full domain name must be tailed by a '.',
  2235. { but in normal behavior, user will not input '.' in last
  2236. { position of the full name. So we have to compare both of the
  2237. { cases.
  2238. }
  2239. if (Copy(QName, Length(QName), 1) = '.') then begin
  2240. QName := Copy(QName, 1, Length(QName)-1);
  2241. end;
  2242. RRIndex := TargetNode.RRs.ItemNames.IndexOf(AnsiLowercase(QName));
  2243. { above are added again by Dennies Chang in 2004/7/15}
  2244. if RRIndex = -1 then begin
  2245. QName:= Fetch(QName, '.');
  2246. RRIndex := TargetNode.RRs.ItemNames.IndexOf(AnsiLowercase(QName));
  2247. end;
  2248. { marked by Dennies Chang in 2004/7/15
  2249. QName:= Fetch(QName, '.');
  2250. RRIndex := TargetNode.RRs.ItemNames.IndexOf(IndyLowerCase(QName));
  2251. }
  2252. end;
  2253. repeat
  2254. temp_QName := QName;
  2255. SetLength(LocalAnswer, 0);
  2256. if RRIndex <> -1 then begin
  2257. case QType of
  2258. TypeCode_A:
  2259. begin
  2260. if TargetNode.RRs.Items[RRIndex] is TIdRR_A then begin
  2261. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2262. end;
  2263. end;
  2264. TypeCode_AAAA:
  2265. begin
  2266. if TargetNode.RRs.Items[RRIndex] is TIdRR_AAAA then begin
  2267. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2268. end;
  2269. end;
  2270. TypeCode_NS:
  2271. begin
  2272. if TargetNode.RRs.Items[RRIndex] is TIdRR_NS then begin
  2273. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName)) and
  2274. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName)) then begin
  2275. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName);
  2276. end;
  2277. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2278. end;
  2279. end;
  2280. TypeCode_MD:
  2281. begin
  2282. if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
  2283. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) and
  2284. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) then begin
  2285. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
  2286. end;
  2287. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2288. end;
  2289. end;
  2290. TypeCode_MF:
  2291. begin
  2292. if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
  2293. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) and
  2294. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) then begin
  2295. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
  2296. end;
  2297. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2298. end;
  2299. end;
  2300. TypeCode_CName:
  2301. begin
  2302. if TargetNode.RRs.Items[RRIndex] is TIdRR_CName then begin
  2303. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_CName).CName)) and
  2304. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_CName).CName)) then begin
  2305. MoreAddrSearch.Add(TIdRR_CName(TargetNode.RRs.Items[RRIndex]).CName);
  2306. end;
  2307. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2308. end;
  2309. end;
  2310. TypeCode_SOA:
  2311. begin
  2312. if TargetNode.RRs.Items[RRIndex] is TIdRR_SOA then begin
  2313. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName)) and
  2314. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName)) then begin
  2315. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName);
  2316. end;
  2317. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName)) and
  2318. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName)) then begin
  2319. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName);
  2320. end;
  2321. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2322. end;
  2323. end;
  2324. TypeCode_MB:
  2325. begin
  2326. if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
  2327. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) and
  2328. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) then begin
  2329. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
  2330. end;
  2331. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2332. end;
  2333. end;
  2334. TypeCode_MG:
  2335. begin
  2336. if TargetNode.RRs.Items[RRIndex] is TIdRR_MG then begin
  2337. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName)) and
  2338. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName)) then begin
  2339. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName);
  2340. end;
  2341. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2342. end;
  2343. end;
  2344. TypeCode_MR:
  2345. begin
  2346. if TargetNode.RRs.Items[RRIndex] is TIdRR_MR then begin
  2347. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName)) and
  2348. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName)) then begin
  2349. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName);
  2350. end;
  2351. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2352. end;
  2353. end;
  2354. TypeCode_NULL:
  2355. begin
  2356. {if TargetNode.RRs.Items[RRIndex] is TIdRR_NULL then
  2357. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2358. }
  2359. end;
  2360. TypeCode_WKS:
  2361. begin
  2362. if TargetNode.RRs.Items[RRIndex] is TIdRR_WKS then begin
  2363. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2364. end;
  2365. end;
  2366. TypeCode_PTR:
  2367. begin
  2368. if TargetNode.RRs.Items[RRIndex] is TIdRR_PTR then begin
  2369. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2370. end;
  2371. end;
  2372. TypeCode_HINFO:
  2373. begin
  2374. if TargetNode.RRs.Items[RRIndex] is TIdRR_HINFO then begin
  2375. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2376. end;
  2377. end;
  2378. TypeCode_MINFO:
  2379. begin
  2380. if TargetNode.RRs.Items[RRIndex] is TIdRR_MINFO then begin
  2381. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2382. end;
  2383. end;
  2384. TypeCode_MX:
  2385. begin
  2386. if TargetNode.RRs.Items[RRIndex] is TIdRR_MX then begin
  2387. if (not IsValidIP(TIdRR_MX(TargetNode.RRs.Items[RRIndex]).Exchange)) and
  2388. (IsHostName(TIdRR_MX(TargetNode.RRs.Items[RRIndex]).Exchange)) then begin
  2389. MoreAddrSearch.Add(TIdRR_MX(TargetNode.RRs.Items[RRIndex]).Exchange);
  2390. end;
  2391. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2392. end;
  2393. end;
  2394. TypeCode_TXT:
  2395. begin
  2396. if TargetNode.RRs.Items[RRIndex] is TIdRR_TXT then begin
  2397. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2398. end;
  2399. end;
  2400. TypeCode_STAR:
  2401. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2402. end;
  2403. if IsWildCard and (Length(LocalAnswer) > 0) then begin
  2404. {temp := DomainNameToDNSStr(QName+'.'+TargetNode.FullName);
  2405. fetch(LocalAnswer, temp);}
  2406. TempBytes := DomainNameToDNSStr(QName+'.'+TargetNode.FullName);
  2407. FetchBytes(LocalAnswer, ToBytes(temp));
  2408. TempBytes := DomainNameToDNSStr(WildCardOrgName);
  2409. AppendBytes(TempBytes, LocalAnswer);
  2410. LocalAnswer := TempBytes;
  2411. //LocalAnswer := DomainNameToDNSStr(WildCardOrgName) + LocalAnswer;
  2412. end;
  2413. if Length(LocalAnswer) > 0 then
  2414. begin
  2415. AppendBytes(Answer, LocalAnswer);
  2416. if ((not Extra) and (not IsAdditional)) or (QType = TypeCode_AAAA) then begin
  2417. if (TargetNode.RRs.Items[RRIndex] is TIdRR_NS) then begin
  2418. if IfMainQuestion then Header.ANCount := Header.ANCount + 1
  2419. else Header.NSCount := Header.NSCount + 1;
  2420. end else begin
  2421. if IfMainQuestion then Header.ANCount := Header.ANCount + 1
  2422. else Header.ARCount := Header.ARCount + 1;
  2423. end;
  2424. end else begin
  2425. if IsAdditional then begin
  2426. Header.ARCount := Header.ARCount + 1;
  2427. end else begin
  2428. Header.ANCount := Header.ANCount + 1;
  2429. end;
  2430. { modified by Dennies Chang in 2004/7/15
  2431. { do not localize..... because ANCount and ARCount
  2432. { is different in DNSResolver.
  2433. Header.ANCount := Header.ANCount + 1
  2434. }
  2435. end;
  2436. Header.Qr := iQr_Answer;
  2437. Header.AA := iAA_Authoritative;
  2438. Header.RCode := iRCodeNoError;
  2439. end;
  2440. if RRIndex < TargetNode.RRs.ItemNames.Count -1 then begin
  2441. Stop := False;
  2442. Inc(RRIndex);
  2443. end else begin
  2444. Stop := True;
  2445. end;
  2446. end else begin
  2447. Stop := True;
  2448. end;
  2449. if QName = temp_QName then temp_QName := '';
  2450. until (RRIndex = -1) or
  2451. (not ((IndyLowerCase(TargetNode.RRs.ItemNames.Strings[RRIndex]) <> IndyLowerCase(QName)) xor
  2452. (IndyLowerCase(TargetNode.RRs.ItemNames.Strings[RRIndex]) <> IndyLowerCase(Fetch(temp_QName, '.')))))
  2453. or (Stop);
  2454. // Finish the Loop, but n record is found, we need to search if
  2455. // there is a widechar record in its subdomain.
  2456. // Main, Cache, Additional, Wildcard
  2457. if Length(Answer) > 0 then begin
  2458. InternalSearch(Header, '*.'+QName, QType, Answer, IfMAinQuestion,
  2459. False, False, True, QName);
  2460. end;
  2461. end else begin // Node can't be found.
  2462. MoreAddrSearch.Clear;
  2463. end;
  2464. if MoreAddrSearch.Count > 0 then begin
  2465. for Count := 0 to MoreAddrSearch.Count -1 do begin
  2466. Server_Index := 0;
  2467. if Self.Handed_DomainList.Count > 0 then begin
  2468. repeat
  2469. if (IndyPos(IndyLowerCase(Self.Handed_DomainList.Strings[Server_Index]),
  2470. IndyLowerCase(MoreAddrSearch.Strings[Count])) > 0) then begin
  2471. IsMyDomains := True;
  2472. end else begin
  2473. IsMyDomains := False;
  2474. end;
  2475. Inc(Server_Index);
  2476. until IsMyDomains or (Server_Index > Self.Handed_DomainList.Count -1);
  2477. end else begin
  2478. IsMyDomains := False;
  2479. end;
  2480. if IsMyDomains then begin
  2481. //ifAdditional := (QType <> TypeCode_A) or (QType <> TypeCode_AAAA);
  2482. // modified by Dennies Chang in 2004/7/15.
  2483. ifAdditional := (QType <> TypeCode_CName);
  2484. //Search A record first.
  2485. // Main, Cache, Additional, Wildcard
  2486. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A,
  2487. LocalAnswer, True, False, ifAdditional, False);
  2488. { modified by Dennies Chang in 2004/7/15.
  2489. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A,
  2490. LocalAnswer, True, ifAdditional, True);}
  2491. if Length(LocalAnswer) = 0 then begin
  2492. temp := MoreAddrSearch.Strings[Count];
  2493. Fetch(temp, '.');
  2494. temp := '*.' + temp;
  2495. InternalSearch(Header, temp, TypeCode_A,
  2496. LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
  2497. { marked by Dennies Chang in 2004/7/15.
  2498. InternalSearch(Header, temp, TypeCode_A,
  2499. LocalAnswer, True, ifAdditional, True, True, MoreAddrSearch.Strings[Count]);
  2500. }
  2501. end;
  2502. TempAnswer := LocalAnswer;
  2503. // Search for AAAA also.
  2504. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA,
  2505. LocalAnswer, True, False, ifAdditional, True);
  2506. { marked by Dennies Chang in 2004/7/15.
  2507. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA,
  2508. LocalAnswer, True, ifAdditional, True);
  2509. }
  2510. if Length(LocalAnswer) = 0 then begin
  2511. temp := MoreAddrSearch.Strings[Count];
  2512. Fetch(temp, '.');
  2513. temp := '*.' + temp;
  2514. InternalSearch(Header, temp, TypeCode_AAAA,
  2515. LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
  2516. { marked by Dennies Chang in 2004/7/15.
  2517. InternalSearch(Header, temp, TypeCode_AAAA,
  2518. LocalAnswer, True, ifAdditional, True, True, MoreAddrSearch.Strings[Count]);
  2519. }
  2520. end;
  2521. AppendBytes(TempAnswer, LocalAnswer);
  2522. LocalAnswer := TempAnswer;
  2523. end else begin
  2524. // Need add AAAA Search in future.
  2525. //QType := TypeCode_A;
  2526. LDNSResolver := TIdDNSResolver.Create(self);
  2527. Server_Index := 0;
  2528. repeat
  2529. LDNSResolver.Host := Self.RootDNS_NET.Strings[Server_Index];
  2530. LDNSResolver.QueryType := [qtA];
  2531. LDNSResolver.Resolve(MoreAddrSearch.Strings[Count]);
  2532. AResult := LDNSResolver.PlainTextResult;
  2533. Header.ARCount := Header.ARCount + LDNSResolver.QueryResult.Count;
  2534. until (Server_Index >= Self.RootDNS_NET.Count - 1) or (Length(AResult) > 0);
  2535. AppendBytes(LocalAnswer, Copy(AResult, 13, Length(AResult) -12));
  2536. LDNSResolver.Free;
  2537. end;
  2538. AppendBytes(Answer, LocalAnswer);
  2539. //Answer := LocalAnswer;
  2540. end;
  2541. end;
  2542. end else begin
  2543. //Search the Cache Tree;
  2544. { marked by Dennies Chang in 2004/7/15.
  2545. { it's mark for querying cache only.
  2546. {if Length(Answer) = 0 then begin
  2547. }
  2548. TargetNode := SearchTree(Self.Cached_Tree, QName, QType);
  2549. if TargetNode <> nil then begin //Assemble the Answer.
  2550. { modified by Dennies Chang in 2004/7/15}
  2551. if (QType = TypeCode_A) or (QType = TypeCode_PTR) or
  2552. (QType = TypeCode_AAAA) or (QType = TypeCode_Error) or (QType = TypeCode_CName) then
  2553. begin
  2554. QName:= Fetch(QName, '.');
  2555. end;
  2556. RRIndex := TargetNode.RRs.ItemNames.IndexOf(QName);
  2557. repeat
  2558. temp_QName := QName;
  2559. SetLength(LocalAnswer, 0);
  2560. if RRIndex <> -1 then begin
  2561. TM1 := DateTimeToTimeStamp(Now);
  2562. TM2 := DateTimeToTimeStamp(StrToDateTime(TargetNode.RRs.Items[RRIndex].TimeOut));
  2563. // TimeOut, update the record.
  2564. if (((TM1.Date = TM2.Date) and (TM1.Time > TM2.Time)) or
  2565. (TM1.Date > TM2.Date)) then begin
  2566. SetLength(LocalAnswer, 0)
  2567. end else begin
  2568. case QType of
  2569. TypeCode_Error:
  2570. begin
  2571. AppendBytes(Answer, ToBytes('Error')); {do not localize}
  2572. end;
  2573. TypeCode_A:
  2574. begin
  2575. if TargetNode.RRs.Items[RRIndex] is TIdRR_A then begin
  2576. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2577. end;
  2578. end;
  2579. TypeCode_AAAA:
  2580. begin
  2581. if TargetNode.RRs.Items[RRIndex] is TIdRR_AAAA then begin
  2582. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2583. end;
  2584. end;
  2585. TypeCode_NS:
  2586. begin
  2587. if TargetNode.RRs.Items[RRIndex] is TIdRR_NS then begin
  2588. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName)) and
  2589. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName)) then begin
  2590. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName);
  2591. end;
  2592. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2593. end;
  2594. end;
  2595. TypeCode_MD:
  2596. begin
  2597. if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
  2598. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) and
  2599. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) then begin
  2600. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
  2601. end;
  2602. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2603. end;
  2604. end;
  2605. TypeCode_MF:
  2606. begin
  2607. if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
  2608. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) and
  2609. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) then begin
  2610. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
  2611. end;
  2612. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2613. end;
  2614. end;
  2615. TypeCode_CName:
  2616. begin
  2617. if TargetNode.RRs.Items[RRIndex] is TIdRR_CName then begin
  2618. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_CName).CName)) and
  2619. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_CName).CName)) then begin
  2620. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_CName).CName);
  2621. end;
  2622. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2623. end;
  2624. end;
  2625. TypeCode_SOA:
  2626. begin
  2627. if TargetNode.RRs.Items[RRIndex] is TIdRR_SOA then begin
  2628. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName)) and
  2629. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName)) then begin
  2630. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName);
  2631. end;
  2632. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName)) and
  2633. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName)) then begin
  2634. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName);
  2635. end;
  2636. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2637. end;
  2638. end;
  2639. TypeCode_MB:
  2640. begin
  2641. if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
  2642. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) and
  2643. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName)) then begin
  2644. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
  2645. end;
  2646. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2647. end;
  2648. end;
  2649. TypeCode_MG:
  2650. begin
  2651. if TargetNode.RRs.Items[RRIndex] is TIdRR_MG then begin
  2652. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName)) and
  2653. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName)) then begin
  2654. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName);
  2655. end;
  2656. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2657. end;
  2658. end;
  2659. TypeCode_MR:
  2660. begin
  2661. if TargetNode.RRs.Items[RRIndex] is TIdRR_MR then begin
  2662. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName)) and
  2663. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName)) then begin
  2664. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName);
  2665. end;
  2666. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2667. end;
  2668. end;
  2669. TypeCode_NULL:
  2670. begin
  2671. {if TargetNode.RRs.Items[RRIndex] is TIdRR_NULL then begin
  2672. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2673. }
  2674. end;
  2675. TypeCode_WKS:
  2676. begin
  2677. if TargetNode.RRs.Items[RRIndex] is TIdRR_WKS then begin
  2678. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2679. end;
  2680. end;
  2681. TypeCode_PTR:
  2682. begin
  2683. if TargetNode.RRs.Items[RRIndex] is TIdRR_PTR then begin
  2684. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2685. end;
  2686. end;
  2687. TypeCode_HINFO:
  2688. begin
  2689. if TargetNode.RRs.Items[RRIndex] is TIdRR_HINFO then begin
  2690. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2691. end;
  2692. end;
  2693. TypeCode_MINFO:
  2694. begin
  2695. if TargetNode.RRs.Items[RRIndex] is TIdRR_MINFO then begin
  2696. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2697. end;
  2698. end;
  2699. TypeCode_MX:
  2700. begin
  2701. if TargetNode.RRs.Items[RRIndex] is TIdRR_MX then begin
  2702. if (not IsValidIP((TargetNode.RRs.Items[RRIndex] as TIdRR_MX).Exchange)) and
  2703. (IsHostName((TargetNode.RRs.Items[RRIndex] as TIdRR_MX).Exchange)) then begin
  2704. MoreAddrSearch.Add((TargetNode.RRs.Items[RRIndex] as TIdRR_MX).Exchange);
  2705. end;
  2706. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2707. end;
  2708. end;
  2709. TypeCode_TXT:
  2710. begin
  2711. if TargetNode.RRs.Items[RRIndex] is TIdRR_TXT then begin
  2712. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2713. end;
  2714. end;
  2715. TypeCode_STAR:
  2716. LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
  2717. end;
  2718. end;
  2719. if BytesToString(LocalAnswer) = 'Error' then {do not localize}
  2720. Stop := True
  2721. else begin
  2722. if Length(LocalAnswer) > 0 then begin
  2723. AppendBytes(Answer, LocalAnswer);
  2724. if (TargetNode.RRs.Items[RRIndex] is TIdRR_NS) then begin
  2725. if IfMainQuestion then Header.ANCount := Header.ANCount + 1
  2726. else Header.NSCount := Header.NSCount + 1;
  2727. end else begin
  2728. if IfMainQuestion then Header.ANCount := Header.ANCount + 1
  2729. else Header.ARCount := Header.ARCount + 1;
  2730. end;
  2731. Header.Qr := iQr_Answer;
  2732. Header.AA := iAA_NotAuthoritative;
  2733. Header.RCode := iRCodeNoError;
  2734. end;
  2735. if RRIndex < TargetNode.RRs.ItemNames.Count -1 then begin
  2736. Stop := False;
  2737. Inc(RRIndex);
  2738. end else begin
  2739. Stop := True
  2740. end;
  2741. end;
  2742. end else begin
  2743. Stop := True;
  2744. end;
  2745. until (RRIndex = -1) or
  2746. (not ((IndyLowerCase(TargetNode.RRs.ItemNames.Strings[RRIndex]) <> IndyLowerCase(QName)) xor
  2747. (IndyLowerCase(TargetNode.RRs.ItemNames.Strings[RRIndex]) <> IndyLowerCase(Fetch(temp_QName, '.')))))
  2748. or (Stop);
  2749. end;
  2750. // Search MoreAddrSearch it's added in 2004/7/15, but the need is
  2751. // found in 2004 Feb.
  2752. if MoreAddrSearch.Count > 0 then begin
  2753. for Count := 0 to MoreAddrSearch.Count -1 do begin
  2754. Server_Index := 0;
  2755. if Self.Handed_DomainList.Count > 0 then begin
  2756. repeat
  2757. if (AnsiPos(AnsiLowercase(Self.Handed_DomainList.Strings[Server_Index]),
  2758. AnsiLowercase(MoreAddrSearch.Strings[Count])) > 0) then begin
  2759. IsMyDomains := True;
  2760. end else begin
  2761. IsMyDomains := False;
  2762. end;
  2763. Inc(Server_Index);
  2764. until IsMyDomains or (Server_Index > Self.Handed_DomainList.Count -1);
  2765. end else begin
  2766. IsMyDomains := False;
  2767. end;
  2768. if IsMyDomains then begin
  2769. ifAdditional := (QType <> TypeCode_A) or (QType <> TypeCode_AAAA);
  2770. //Search A record first.
  2771. // Main, Cache, Additional, Wildcard
  2772. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A,
  2773. LocalAnswer, True, False, ifAdditional, False);
  2774. if Length(LocalAnswer) = 0 then begin
  2775. temp := MoreAddrSearch.Strings[Count];
  2776. Fetch(temp, '.');
  2777. temp := '*.' + temp;
  2778. InternalSearch(Header, temp, TypeCode_A,
  2779. LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
  2780. end;
  2781. TempAnswer := LocalAnswer;
  2782. // Search for AAAA also.
  2783. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA,
  2784. LocalAnswer, True, False, ifAdditional, True);
  2785. if Length(LocalAnswer) = 0 then begin
  2786. temp := MoreAddrSearch.Strings[Count];
  2787. Fetch(temp, '.');
  2788. temp := '*.' + temp;
  2789. InternalSearch(Header, temp, TypeCode_AAAA,
  2790. LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
  2791. end;
  2792. AppendBytes(TempAnswer, LocalAnswer);
  2793. LocalAnswer := TempAnswer;
  2794. end else begin
  2795. // ��Cache
  2796. TempAnswer := LocalAnswer;
  2797. ifAdditional := (QType <> TypeCode_A) or (QType <> TypeCode_AAAA);
  2798. //Search A record first.
  2799. // Main, Cache, Additional, Wildcard
  2800. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A,
  2801. LocalAnswer, True, True, ifAdditional, False);
  2802. if Length(LocalAnswer) = 0 then begin
  2803. temp := MoreAddrSearch.Strings[Count];
  2804. Fetch(temp, '.');
  2805. temp := '*.' + temp;
  2806. InternalSearch(Header, temp, TypeCode_A,
  2807. LocalAnswer, True, True, ifAdditional, True, MoreAddrSearch.Strings[Count]);
  2808. end;
  2809. AppendBytes(TempAnswer, LocalAnswer);
  2810. LocalAnswer := TempAnswer;
  2811. // Search for AAAA also.
  2812. InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA,
  2813. LocalAnswer, True, True, ifAdditional, True);
  2814. AppendBytes(TempAnswer, LocalAnswer);
  2815. LocalAnswer := TempAnswer;
  2816. end;
  2817. Answer := LocalAnswer;
  2818. end;
  2819. end;
  2820. { marked by Dennies Chang in 2004/7/15 (the bug is found in 2003 Dec.)
  2821. end;
  2822. }
  2823. end; // End of search Cache.
  2824. MoreAddrSearch.Free;
  2825. end;
  2826. { TIdDNSServer }
  2827. procedure TIdDNSServer.CheckIfExpire(Sender: TObject);
  2828. begin
  2829. end;
  2830. procedure TIdDNSServer.InitComponent;
  2831. begin
  2832. inherited;
  2833. Self.FAccessList := TIdStringList.Create;
  2834. Self.FUDPTunnel := TIdDNS_UDPServer.Create(Self);
  2835. Self.FTCPTunnel := TIdDNS_TCPServer.Create(Self);
  2836. Self.FBindings := TIdSocketHandles.Create(Self);
  2837. Self.FTCPTunnel.DefaultPort := IdPORT_DOMAIN;
  2838. Self.FUDPTunnel.DefaultPort := IdPORT_DOMAIN;
  2839. Self.ServerType := stPrimary;
  2840. Self.BackupDNSMap := TIdDNSMap.Create(Self.UDPTunnel);
  2841. end;
  2842. destructor TIdDNSServer.Destroy;
  2843. begin
  2844. Self.FAccessList.Free;
  2845. Self.FUDPTunnel.Free;
  2846. Self.FTCPTunnel.Free;
  2847. Self.FBindings.Free;
  2848. Self.BackupDNSMap.Free;
  2849. inherited Destroy;
  2850. end;
  2851. procedure TIdDNSServer.SetAccessList(const Value: TIdStrings);
  2852. begin
  2853. FAccessList.Assign(Value);
  2854. Self.FTCPTunnel.AccessList.Assign(Value);
  2855. end;
  2856. procedure TIdDNSServer.SetActive(const Value: boolean);
  2857. var
  2858. Count : integer;
  2859. DNSMap : TIdDomainNameServerMapping;
  2860. begin
  2861. FActive := Value;
  2862. Self.FUDPTunnel.Active := Value;
  2863. if Self.ServerType = stSecondary then begin
  2864. Self.TCPTunnel.Active := False;
  2865. for Count := 0 to Self.BackupDNSMap.Count -1 do begin
  2866. DNSMap := Self.BackupDNSMap.Items[Count];
  2867. DNSMap.CheckScheduler.Start;
  2868. end;
  2869. end else Self.TCPTunnel.Active := Value;
  2870. end;
  2871. procedure TIdDNSServer.SetBindings(const Value: TIdSocketHandles);
  2872. begin
  2873. FBindings.Assign(Value);
  2874. Self.FUDPTunnel.Bindings.Assign(Value);
  2875. Self.FTCPTunnel.Bindings.Assign(Value);
  2876. end;
  2877. procedure TIdDNSServer.SetTCPACLActive(const Value: boolean);
  2878. begin
  2879. FTCPACLActive := Value;
  2880. Self.TCPTunnel.AccessControl := Value;
  2881. if Value then Self.FTCPTunnel.FAccessList.Assign(Self.FAccessList)
  2882. else Self.FTCPTunnel.FAccessList.Clear;
  2883. end;
  2884. procedure TIdDNSServer.TimeToUpdateNodeData(Sender: TObject);
  2885. var
  2886. Resolver : TIdDNSResolver;
  2887. Count : integer;
  2888. begin
  2889. Resolver := TIdDNSResolver.Create(Self);
  2890. Resolver.Host := Self.UDPTunnel.RootDNS_NET.Strings[0];
  2891. Resolver.QueryType := [qtAXFR];
  2892. try
  2893. Resolver.Resolve((Sender as TIdDNTreeNode).FullName);
  2894. for Count := 0 to Resolver.QueryResult.Count -1 do begin
  2895. Self.UDPTunnel.UpdateTree(Self.UDPTunnel.Handed_Tree, Resolver.QueryResult.items[Count]);
  2896. end;
  2897. finally
  2898. Resolver.Free;
  2899. end;
  2900. end;
  2901. { TIdDNS_TCPServer }
  2902. procedure TIdDNS_TCPServer.InitComponent;
  2903. begin
  2904. inherited;
  2905. Self.FAccessList := TIdStringList.Create;
  2906. end;
  2907. destructor TIdDNS_TCPServer.Destroy;
  2908. begin
  2909. Self.FAccessList.Free;
  2910. inherited Destroy;
  2911. end;
  2912. procedure TIdDNS_TCPServer.DoConnect(AThread: TIdContext);
  2913. var
  2914. Answer: TIdBytes;
  2915. Data, Question: TIdBytes;
  2916. QName, QLabel, QResult, PeerIP : string;
  2917. LData, QPos, LLength :integer;
  2918. TestHeader : TDNSHeader;
  2919. procedure GenerateAXFRData;
  2920. begin
  2921. TestHeader := TDNSHeader.Create;
  2922. try
  2923. TestHeader.ParseQuery(Data);
  2924. if TestHeader.QDCount >= 1 then begin
  2925. // parse the question.
  2926. QPos := 13;
  2927. QLabel := '';
  2928. QName := '';
  2929. repeat
  2930. LLength := Byte(Data[QPos]);
  2931. Inc(QPos);
  2932. QLabel := BytesToString(Data, QPos, LLength);
  2933. Inc(QPos, LLength);
  2934. if QName <> '' then begin
  2935. QName := QName + QLabel + '.'
  2936. end else begin
  2937. QName := QLabel + '.';
  2938. end;
  2939. until ((QPos >= LData) or (Data[QPos] = 0));
  2940. Question := Copy(Data, 13, length(Data)-12);
  2941. QResult := TIdDNSServer(Self.Owner).UDPTunnel.AXFR(TestHeader, QName, Answer);
  2942. end;
  2943. finally
  2944. TestHeader.Free;
  2945. end;
  2946. end;
  2947. procedure GenerateAXFRRefuseData;
  2948. begin
  2949. TestHeader := TDNSHeader.Create;
  2950. try
  2951. TestHeader.ParseQuery(Data);
  2952. TestHeader.Qr := iQr_Answer;
  2953. TestHeader.RCode := iRCodeRefused;
  2954. Answer := TestHeader.GenerateBinaryHeader;
  2955. finally
  2956. TestHeader.Free;
  2957. end;
  2958. end;
  2959. begin
  2960. inherited DoConnect(AThread);
  2961. LData := AThread.Connection.IOHandler.ReadSmallInt();
  2962. SetLength(Data, 0);
  2963. // RLebeau - why not use ReadBuffer() here?
  2964. // Dennies - Sure, in older version, my concern is for real time generate system
  2965. // might not generate the data with correct data size we expect.
  2966. AThread.Connection.IOHandler.ReadBytes(Data, LData);
  2967. {for Count := 1 to LData do begin
  2968. AppendByte(Data, Byte(AThread.Connection.IOHandler.ReadChar));
  2969. end;
  2970. }
  2971. // PeerIP is ip address.
  2972. PeerIP := (AThread.Connection.IOHandler as TIdIOHandlerSocket).Binding.PeerIP;
  2973. if (Self.AccessControl) and (Self.AccessList.IndexOf(PeerIP) = -1) then begin
  2974. GenerateAXFRRefuseData;
  2975. end else begin
  2976. GenerateAXFRData;
  2977. end;
  2978. AThread.Connection.IOHandler.Write(SmallInt(Length(Answer)));
  2979. AThread.Connection.IOHandler.Write(Answer);
  2980. end;
  2981. procedure TIdDNS_TCPServer.SetAccessList(const Value: TIdStrings);
  2982. begin
  2983. FAccessList.Assign(Value);
  2984. end;
  2985. { TIdDomainExpireCheckThread }
  2986. procedure TIdDomainExpireCheckThread.Run;
  2987. var
  2988. LInterval: Integer;
  2989. begin
  2990. LInterval := FInterval;
  2991. while LInterval > 0 do begin
  2992. if LInterval > 500 then begin
  2993. Sleep(500);
  2994. LInterval := LInterval - 500;
  2995. end else begin
  2996. Sleep(LInterval);
  2997. LInterval := 0;
  2998. end;
  2999. if Terminated then begin
  3000. exit;
  3001. end;
  3002. Synchronize(TimerEvent);
  3003. end;
  3004. end;
  3005. procedure TIdDomainExpireCheckThread.TimerEvent;
  3006. begin
  3007. FTimerEvent(FSender);
  3008. end;
  3009. { TIdDomainNameServerMapping }
  3010. constructor TIdDomainNameServerMapping.Create(List :TIdDNSMap);
  3011. begin
  3012. inherited Create;
  3013. Self.CheckScheduler := TIdDomainExpireCheckThread.Create();
  3014. Self.CheckScheduler.FInterval := 100000;
  3015. Self.CheckScheduler.FSender := self;
  3016. Self.CheckScheduler.FDomain := Self.DomainName;
  3017. Self.CheckScheduler.FHost := self.Host;
  3018. Self.CheckScheduler.FTimerEvent := Self.SyncAndUpdate;
  3019. Self.List := List;
  3020. Self.FBusy := False;
  3021. end;
  3022. destructor TIdDomainNameServerMapping.Destroy;
  3023. begin
  3024. //Self.CheckScheduler.TerminateAndWaitFor;
  3025. Self.CheckScheduler.Terminate;
  3026. Self.CheckScheduler.Free;
  3027. inherited;
  3028. end;
  3029. procedure TIdDomainNameServerMapping.SetHost(const Value: string);
  3030. begin
  3031. if IsValidIP(Value) or IsValidIPv6(Value) then begin
  3032. FHost := Value;
  3033. end else begin
  3034. raise EIdDNSServerSettingException.Create(RSDNSServerSettingError_MappingHostError);
  3035. end;
  3036. end;
  3037. procedure TIdDomainNameServerMapping.SetInterval(const Value: Cardinal);
  3038. begin
  3039. FInterval := Value;
  3040. Self.CheckScheduler.FInterval := Value;
  3041. end;
  3042. procedure TIdDomainNameServerMapping.SyncAndUpdate(Sender: TObject);
  3043. //Todo - Dennies Chang should append axfr and update Tree.
  3044. var
  3045. Resolver : TIdDNSResolver;
  3046. RR : TResultRecord;
  3047. TNode : TIdDNTreeNode;
  3048. Server : TIdDNS_UDPServer;
  3049. NeedUpdated, NotThis : boolean;
  3050. Count, TIndex : integer;
  3051. RRName : string;
  3052. begin
  3053. if Self.FBusy then begin
  3054. Exit;
  3055. end else begin
  3056. Self.FBusy := True;
  3057. end;
  3058. Resolver := TIdDNSResolver.Create(nil);
  3059. Resolver.Host := Self.Host;
  3060. Resolver.QueryType := [qtAXFR];
  3061. try
  3062. Resolver.Resolve(Self.DomainName);
  3063. RR := Resolver.QueryResult.Items[0];
  3064. if RR.RecType <> qtSOA then begin
  3065. raise EIdDNSServerSyncException.Create(RSDNSServerAXFRError_QuerySequenceError);
  3066. end else begin
  3067. Server := Self.List.Server;
  3068. Self.Interval := TSOARecord(RR).Expire * 1000;
  3069. {//Update MyDomain
  3070. if Copy(RR.Name, Length(RR.Name),1) <> '.' then begin
  3071. RRName := RR.Name + '.';
  3072. end;
  3073. }
  3074. if Server.Handed_DomainList.IndexOf(RR.Name) = -1 then begin
  3075. Server.Handed_DomainList.Add(RR.Name);
  3076. end;
  3077. TNode := Server.SearchTree(Server.Handed_Tree, RR.Name, TypeCode_SOA);
  3078. if TNode = nil then begin
  3079. NeedUpdated := True;
  3080. end else begin
  3081. RRName := RRName;
  3082. RRName := Fetch(RRName, '.');
  3083. TIndex := TNode.RRs.ItemNames.IndexOf(RR.Name);
  3084. NotThis := True;
  3085. while ((TIndex > -1) and (TIndex <= TNode.RRs.Count -1) and
  3086. (TNode.RRs.Items[TIndex].RRName = RR.Name) and (NotThis)) do begin
  3087. NotThis := not (TNode.RRs.Items[TIndex] is TIdRR_SOA);
  3088. Inc(TIndex);
  3089. end;
  3090. if not NotThis then begin
  3091. Dec(TIndex);
  3092. NeedUpdated := ((TNode.RRs.Items[TIndex] as TIdRR_SOA).Serial = IntToStr(TSOARecord(RR).Serial));
  3093. end else begin
  3094. NeedUpdated := True;
  3095. end;
  3096. end;
  3097. if NeedUpdated then begin
  3098. if TNode <> nil then begin
  3099. Server.Handed_Tree.RemoveChild(Server.Handed_Tree.IndexByNode(TNode));
  3100. end;
  3101. for count := 0 to Resolver.QueryResult.Count - 1 do begin
  3102. RR := Resolver.QueryResult.Items[count];
  3103. Server.UpdateTree(Server.Handed_Tree, RR);
  3104. end;
  3105. end;
  3106. end;
  3107. finally
  3108. Self.FBusy := False;
  3109. Resolver.Free;
  3110. end;
  3111. end;
  3112. { TIdDNSMap }
  3113. constructor TIdDNSMap.Create(Server: TIdDNS_UDPServer);
  3114. begin
  3115. inherited Create;
  3116. Self.FServer := Server;
  3117. end;
  3118. destructor TIdDNSMap.Destroy;
  3119. var
  3120. Count : integer;
  3121. DNSMP : TIdDomainNameServerMapping;
  3122. begin
  3123. if Self.Count > 0 then begin
  3124. for Count := Self.Count -1 downto 0 do begin
  3125. DNSMP := Self.Items[Count];
  3126. DNSMP.Free;
  3127. Self.Delete(Count);
  3128. end;
  3129. end;
  3130. inherited;
  3131. end;
  3132. function TIdDNSMap.GetItem(Index: Integer): TIdDomainNameServerMapping;
  3133. begin
  3134. Result := TIdDomainNameServerMapping(inherited GetItem(Index));
  3135. end;
  3136. procedure TIdDNSMap.SetItem(Index: Integer;
  3137. const Value: TIdDomainNameServerMapping);
  3138. begin
  3139. inherited SetItem(Index, Value);
  3140. end;
  3141. procedure TIdDNSMap.SetServer(const Value: TIdDNS_UDPServer);
  3142. begin
  3143. FServer := Value;
  3144. end;
  3145. { TIdDNS_ProcessThread }
  3146. constructor TIdDNS_ProcessThread.Create(ACreateSuspended: Boolean;
  3147. Data: String; DataSize: integer; MainBinding, Binding: TIdSocketHandle;
  3148. Server: TIdDNS_UDPServer);
  3149. begin
  3150. inherited Create(ACreateSuspended);
  3151. Self.FMyData := nil;
  3152. Self.FData := Data;
  3153. Self.FDataSize := DataSize;
  3154. Self.FMyBinding := Binding;
  3155. Self.FMainBinding := MainBinding;
  3156. Self.FServer := Server;
  3157. Self.FreeOnTerminate := True;
  3158. end;
  3159. procedure TIdDNS_ProcessThread.ComposeErrorResult(var Final: TIdBytes;
  3160. OriginalHeader: TDNSHeader; OriginalQuestion : TIdBytes;
  3161. ErrorStatus: integer);
  3162. begin
  3163. case ErrorStatus of
  3164. iRCodeQueryNotImplement :
  3165. begin
  3166. OriginalHeader.Qr := iQr_Answer;
  3167. OriginalHeader.RCode := iRCodeNotImplemented;
  3168. Final := OriginalHeader.GenerateBinaryHeader;
  3169. AppendBytes(Final, Copy(OriginalQuestion, 13, Length(OriginalQuestion) - 12));
  3170. end;
  3171. iRCodeQueryNotFound :
  3172. begin
  3173. OriginalHeader.Qr := iQr_Answer;
  3174. OriginalHeader.RCode := iRCodeNameError;
  3175. OriginalHeader.ANCount := 0;
  3176. Final := OriginalHeader.GenerateBinaryHeader;
  3177. //Final := Final;
  3178. end;
  3179. end;
  3180. end;
  3181. destructor TIdDNS_ProcessThread.Destroy;
  3182. begin
  3183. Self.FServer := nil;
  3184. Self.FMainBinding := nil;
  3185. Self.FMyBinding.CloseSocket;
  3186. FreeAndNil(Self.FMyBinding);
  3187. //Self.FMyBinding := nil;
  3188. if Self.FMyData <> nil then begin
  3189. FreeAndNil(Self.FMyData);
  3190. end;
  3191. inherited;
  3192. end;
  3193. procedure TIdDNS_ProcessThread.QueryDomain;
  3194. var
  3195. Temp, QName, QLabel, RString : string;
  3196. ExternalQuery, Answer, FinalResult : TIdBytes;
  3197. DNSHeader_Processing : TDNSHeader;
  3198. QType, QClass : Word;
  3199. QPos, QLength, LLength : integer;
  3200. ABinding: TIdSocketHandle;
  3201. begin
  3202. ExternalQuery := ToBytes(Self.FData);
  3203. ABinding := Self.MyBinding;
  3204. Temp := Self.FData;
  3205. SetLength(FinalResult, 0);
  3206. QType := TypeCode_A;
  3207. if Self.FDataSize >= 12 then begin
  3208. DNSHeader_Processing := TDNSHeader.Create;
  3209. try
  3210. if DNSHeader_Processing.ParseQuery(ExternalQuery) <> 0 then begin
  3211. Self.FServer.DoAfterQuery(ABinding, DNSHeader_Processing, Temp, RString, BytesToString(ExternalQuery));
  3212. AppendBytes(FinalResult, ToBytes(Temp)); // Do not localize;
  3213. end else begin
  3214. if DNSHeader_Processing.QDCount > 0 then begin
  3215. QPos := 13;
  3216. QLength := Length(ExternalQuery);
  3217. if (QLength > 12) then begin
  3218. QName := '';
  3219. repeat
  3220. SetLength(Answer, 0);
  3221. LLength := ExternalQuery[QPos];
  3222. Inc(QPos);
  3223. QLabel := BytesToString(ExternalQuery, QPos, LLength);
  3224. Inc(QPos, LLength);
  3225. if QName <> '' then
  3226. QName := QName + QLabel + '.'
  3227. else
  3228. QName := QLabel + '.';
  3229. until ((QPos >= QLength) or (ExternalQuery[QPos] = 0));
  3230. Inc(QPos);
  3231. QType := TwoByteToWord(ExternalQuery[QPos], ExternalQuery[QPos + 1]);
  3232. Inc(QPos, 2);
  3233. QClass := TwoByteToWord(ExternalQuery[QPos], ExternalQuery[QPos + 1]);
  3234. Self.FServer.DoBeforeQuery(ABinding, DNSHeader_Processing, Temp);
  3235. RString := Self.CompleteQuery(DNSHeader_Processing, QName, ExternalQuery, Answer, QType, QClass, nil);
  3236. if RString = cRCodeQueryNotImplement then begin
  3237. ComposeErrorResult(FinalResult, DNSHeader_Processing, ExternalQuery, iRCodeQueryNotImplement);
  3238. end else begin
  3239. if (RString = cRCodeQueryReturned) then
  3240. FinalResult := Answer
  3241. else begin
  3242. if (RString = cRCodeQueryNotFound) or (RString = cRCodeQueryCacheFindError) then
  3243. ComposeErrorResult(FinalResult, DNSHeader_Processing, ExternalQuery, iRCodeQueryNotFound)
  3244. else
  3245. FinalResult := CombineAnswer(DNSHeader_Processing, ExternalQuery, Answer);
  3246. end;
  3247. end;
  3248. Self.FServer.DoAfterQuery(ABinding, DNSHeader_Processing, Temp, RString, Temp);
  3249. AppendBytes(FinalResult, ToBytes(Temp));
  3250. end;
  3251. end;
  3252. end;
  3253. finally
  3254. try
  3255. Self.FData := BytesToString(FinalResult);
  3256. Self.FDataSize := Length(Self.FData);
  3257. Self.FServer.DoAfterSendBack(ABinding, DNSHeader_Processing, Temp, RString, BytesToString(ExternalQuery));
  3258. if ( (Self.FServer.CacheUnknowZone) and
  3259. (RString <> cRCodeQueryCacheFindError) and
  3260. (RString <> cRCodeQueryCacheOK) and
  3261. (RString <> cRCodeQueryOK) and
  3262. (RString <> cRCodeQueryNotImplement) ) then
  3263. begin
  3264. Self.FServer.SaveToCache(BytesToString(FinalResult), QName, QType);
  3265. Self.FServer.DoAfterCacheSaved(Self.FServer.FCached_Tree);
  3266. end;
  3267. finally
  3268. FreeAndNil(DNSHeader_Processing);
  3269. end;
  3270. end;
  3271. end;
  3272. end;
  3273. procedure TIdDNS_ProcessThread.Run;
  3274. begin
  3275. //inherited;
  3276. try
  3277. //Synchronize(QueryDomain);
  3278. QueryDomain;
  3279. SendData;
  3280. finally
  3281. Self.Stop;
  3282. Self.Terminate;
  3283. end;
  3284. end;
  3285. procedure TIdDNS_ProcessThread.SetMyBinding(const Value: TIdSocketHandle);
  3286. begin
  3287. FMyBinding := Value;
  3288. end;
  3289. procedure TIdDNS_ProcessThread.SetMyData(const Value: TStream);
  3290. begin
  3291. FMyData := Value;
  3292. end;
  3293. procedure TIdDNS_ProcessThread.SetServer(const Value: TIdDNS_UDPServer);
  3294. begin
  3295. FServer := Value;
  3296. end;
  3297. function TIdDNS_ProcessThread.CombineAnswer(Header: TDNSHeader;
  3298. EQuery, Answer: TIdBytes): TIdBytes;
  3299. begin
  3300. Result := Header.GenerateBinaryHeader;
  3301. AppendBytes(Result, Copy(EQuery, 13, Length(EQuery) -12));
  3302. AppendBytes(Result, Answer);
  3303. end;
  3304. procedure TIdDNS_ProcessThread.ExternalSearch(aDNSResolver: TIdDNSResolver; Header: TDNSHeader;
  3305. Question: TIdBytes; var Answer: TIdBytes);
  3306. var
  3307. Server_Index : integer;
  3308. MyDNSResolver : TIdDNSResolver;
  3309. begin
  3310. Server_Index := 0;
  3311. if (aDNSResolver = nil) then
  3312. begin
  3313. MyDNSResolver := TIdDNSResolver.Create;
  3314. MyDNSResolver.WaitingTime := 2000;
  3315. end else
  3316. begin
  3317. MyDNSResolver := aDNSResolver;
  3318. end;
  3319. repeat
  3320. MyDNSResolver.Host := Self.FServer.RootDNS_NET.Strings[Server_Index];
  3321. try
  3322. MyDNSResolver.InternalQuery := Question;
  3323. MyDNSResolver.Resolve('');
  3324. Answer := MyDNSResolver.PlainTextResult;
  3325. except
  3326. // Todo: Create DNS server interal resolver error.
  3327. on EIdDnsResolverError do
  3328. begin
  3329. //Empty Event, for user to custom the event handle.
  3330. end;
  3331. on EIdSocketError do
  3332. begin
  3333. end;
  3334. else
  3335. begin
  3336. end;
  3337. end;
  3338. Inc(Server_Index);
  3339. until ((Server_Index >= Self.FServer.RootDNS_NET.Count) or (Length(Answer) > 0));
  3340. if (aDNSResolver = nil) then
  3341. begin
  3342. MyDNSResolver.Free
  3343. end;
  3344. end;
  3345. procedure TIdDNS_ProcessThread.InternalSearch(Header: TDNSHeader; QName: string; QType: Word;
  3346. var Answer: TIdBytes; IfMainQuestion: boolean; IsSearchCache: boolean = false;
  3347. IsAdditional: boolean = false; IsWildCard : boolean = false;
  3348. WildCardOrgName: string = '');
  3349. begin
  3350. end;
  3351. procedure TIdDNS_ProcessThread.SaveToCache(ResourceRecord,
  3352. QueryName: string; OriginalQType: Word);
  3353. var
  3354. TempResolver : TIdDNSResolver;
  3355. count : integer;
  3356. QType : Word;
  3357. RR : TResultRecord;
  3358. TNode : TIdDNTreeNode;
  3359. RR_Err : TIdRR_Error;
  3360. begin
  3361. TempResolver := TIdDNSResolver.Create(nil);
  3362. TempResolver.FillResultWithOutCheckId(ResourceRecord);
  3363. if TempResolver.FDNSHeader.ANCount > 0 then begin
  3364. for count := 0 to TempResolver.QueryResult.Count - 1 do begin
  3365. RR := TempResolver.QueryResult.Items[Count];
  3366. {
  3367. case RR.RecType of
  3368. qtA : QType := TypeCode_A;
  3369. qtAAAA : QType := TypeCode_AAAA;
  3370. qtNS: QType := TypeCode_NS;
  3371. qtMD: QType := TypeCode_MD;
  3372. qtMF: QType := TypeCode_MF;
  3373. qtName:QType := TypeCode_CName;
  3374. qtSOA: QType := TypeCode_SOA;
  3375. qtMB: QType := TypeCode_MB;
  3376. qtMG: QType := TypeCode_MG;
  3377. qtMR: QType := TypeCode_MR;
  3378. qtNull:QType := TypeCode_Null;
  3379. qtWKS:QType := TypeCode_WKS;
  3380. qtPTR:QType := TypeCode_PTR;
  3381. qtHINFO:QType := TypeCode_HINFO;
  3382. qtMINFO:QType := TypeCode_MINFO;
  3383. qtMX: QType := TypeCode_MX;
  3384. qtTXT: QType := TypeCode_TXT;
  3385. qtSTAR: QType := TypeCode_STAR;
  3386. else QType := TypeCode_STAR;
  3387. end;
  3388. }
  3389. Self.FServer.UpdateTree(Self.FServer.Cached_Tree, RR);
  3390. end; // for loop
  3391. end else begin
  3392. QType := TypeCode_Error;
  3393. TNode := Self.SearchTree(Self.FServer.Cached_Tree, QueryName, QType);
  3394. if TNode = nil then begin
  3395. RR_Err := TIdRR_Error.Create;
  3396. RR_Err.RRName := QueryName;
  3397. RR_Err.TTL := 600;
  3398. Self.FServer.UpdateTree(Self.FServer.Cached_Tree, RR_Err);
  3399. end;
  3400. end;
  3401. FreeAndNil(TempResolver);
  3402. end;
  3403. function TIdDNS_ProcessThread.SearchTree(Root: TIdDNTreeNode;
  3404. QName: String; QType: Word): TIdDNTreeNode;
  3405. var
  3406. RRIndex : integer;
  3407. NodeCursor : TIdDNTreeNode;
  3408. NameLabels : TIdStrings;
  3409. OneNode, FullName : string;
  3410. Found : Boolean;
  3411. begin
  3412. Result := nil;
  3413. NameLabels := TIdStringList.Create;
  3414. FullName := QName;
  3415. NodeCursor := Root;
  3416. Found := False;
  3417. repeat
  3418. OneNode := Fetch(FullName, '.');
  3419. if OneNode <> '' then
  3420. NameLabels.Add(OneNode);
  3421. until FullName = '';
  3422. repeat
  3423. sleep(0);
  3424. if not (QType = TypeCode_SOA) then begin
  3425. RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
  3426. if RRIndex <> -1 then begin
  3427. NameLabels.Delete(NameLabels.Count - 1);
  3428. NodeCursor := NodeCursor.Children[RRIndex];
  3429. if NameLabels.Count = 1 then begin
  3430. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  3431. end else begin
  3432. Found := (NameLabels.Count = 0);
  3433. end;
  3434. end else begin
  3435. if NameLabels.Count = 1 then begin
  3436. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  3437. if not Found then NameLabels.Clear;
  3438. end else begin
  3439. NameLabels.Clear;
  3440. end;
  3441. end;
  3442. end else begin
  3443. RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
  3444. if RRIndex <> -1 then begin
  3445. NameLabels.Delete(NameLabels.Count - 1);
  3446. NodeCursor := NodeCursor.Children[RRIndex];
  3447. if NameLabels.Count = 1 then begin
  3448. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  3449. end else begin
  3450. Found := (NameLabels.Count = 0);
  3451. end;
  3452. end else begin
  3453. if NameLabels.Count = 1 then begin
  3454. Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
  3455. if not Found then NameLabels.Clear;
  3456. end else begin
  3457. NameLabels.Clear;
  3458. end;
  3459. end;
  3460. end;
  3461. until (NameLabels.Count = 0) or (Found);
  3462. if Found then Result := NodeCursor;
  3463. FreeAndNil(NameLabels);
  3464. end;
  3465. function TIdDNS_ProcessThread.CompleteQuery(DNSHeader: TDNSHeader;
  3466. Question: string; OriginalQuestion: TIdBytes; var Answer : TIdBytes;
  3467. QType, QClass : word; DNSResolver : TIdDNSResolver) : string;
  3468. var
  3469. IsMyDomains : boolean;
  3470. lAnswer: TIdBytes;
  3471. WildQuestion, TempDomain : string;
  3472. begin
  3473. // QClass = 1 => IN, we support only "IN" class now.
  3474. // QClass = 2 => CS,
  3475. // QClass = 3 => CH, we suppor "CHAOS" class now, but only "version.bind." info.
  3476. // from 2004/6/28
  3477. // QClass = 4 => HS.
  3478. TempDomain := IndyLowerCase(Question);
  3479. case QClass of
  3480. Class_IN :
  3481. begin
  3482. IsMyDomains := (Self.FServer.Handed_DomainList.IndexOf(TempDomain) > -1);
  3483. if not IsMyDomains then
  3484. begin
  3485. Fetch(TempDomain, '.');
  3486. end;
  3487. IsMyDomains := (Self.FServer.Handed_DomainList.IndexOf(TempDomain) > -1);
  3488. if IsMyDomains then begin
  3489. Self.FServer.InternalSearch(DNSHeader, Question, QType, lAnswer, True, False, False);
  3490. Answer := lAnswer;
  3491. if ((QType = TypeCode_A) or (QType = TypeCode_AAAA)) and
  3492. (Length(Answer) = 0) then
  3493. begin
  3494. Self.FServer.InternalSearch( DNSHeader, Question,
  3495. TypeCode_CNAME, lAnswer,
  3496. True, False, True);
  3497. AppendBytes(Answer, lAnswer);
  3498. end;
  3499. WildQuestion := Question;
  3500. fetch(WildQuestion, '.');
  3501. WildQuestion := '*.' + WildQuestion;
  3502. Self.FServer.InternalSearch( DNSHeader, WildQuestion, QType,
  3503. lAnswer, True, False, False,
  3504. true, Question);
  3505. {Self.FServer.InternalSearch( DNSHeader, Question, QType,
  3506. lAnswer, True, True, False);}
  3507. AppendBytes(Answer, lAnswer);
  3508. if Length(Answer) > 0 then
  3509. Result := cRCodeQueryOK
  3510. else Result := cRCodeQueryNotFound;
  3511. end else begin
  3512. Self.FServer.InternalSearch( DNSHeader, Question, QType,
  3513. Answer, True, True, False);
  3514. if ((QType = TypeCode_A) or (QType = TypeCode_AAAA)) and
  3515. (Length(Answer) = 0) then begin
  3516. Self.FServer.InternalSearch( DNSHeader, Question,
  3517. TypeCode_CNAME, lAnswer,
  3518. True, True, False);
  3519. AppendBytes(Answer, lAnswer);
  3520. end;
  3521. if Length(Answer) > 0 then
  3522. Result := cRCodeQueryCacheOK
  3523. else begin
  3524. QType := TypeCode_Error;
  3525. Self.FServer.InternalSearch( DNSHeader, Question,
  3526. QType, Answer, True,
  3527. True, False);
  3528. if BytesToString(Answer) = 'Error' then begin {do not localize}
  3529. Result := cRCodeQueryCacheFindError;
  3530. end else begin
  3531. Self.FServer.ExternalSearch(DNSResolver, DNSHeader,
  3532. OriginalQuestion, Answer);
  3533. if Length(Answer) > 0 then
  3534. Result := cRCodeQueryReturned
  3535. else Result := cRCodeQueryNotImplement;
  3536. end;
  3537. end;
  3538. end;
  3539. end; // End of Class_IN
  3540. Class_CHAOS : begin
  3541. if TempDomain = 'version.bind.' then begin {do not localize}
  3542. if Self.FServer.offerDNSVersion then begin
  3543. lAnswer := DomainNameToDNSStr('version.bind.'); {do not localize}
  3544. AppendBytes(lAnswer, ToBytes(SmallInt((TypeCode_TXT))));
  3545. AppendBytes(lAnswer, ToBytes(SmallInt(Class_CHAOS)));
  3546. AppendBytes(lAnswer, ToBytes(('86400'))); {do not localize}
  3547. AppendBytes(lAnswer, ToBytes((Length(NormalStrToDNSStr(Self.FServer.DNSVersion)))));
  3548. AppendBytes(lAnswer, NormalStrToDNSStr(Self.FServer.DNSVersion));
  3549. Answer := lAnswer;
  3550. DNSHeader.ANCount := 1;
  3551. DNSHeader.AA := 1;
  3552. Result := cRCodeQueryOK;
  3553. end else begin
  3554. Result := cRCodeQueryNotImplement;
  3555. end;
  3556. end else begin
  3557. Result := cRCodeQueryNotImplement;
  3558. end;
  3559. end;
  3560. else Result := cRCodeQueryNotImplement;
  3561. end;
  3562. end;
  3563. procedure TIdDNS_ProcessThread.SendData;
  3564. begin
  3565. Self.FServer.GlobalCS.Enter;
  3566. try
  3567. Self.FMainBinding.SendTo(Self.FMyBinding.PeerIP, Self.FMyBinding.PeerPort, ToBytes(Self.FData));
  3568. finally
  3569. Self.FServer.GlobalCS.Leave;
  3570. end;
  3571. end;
  3572. procedure TIdDNS_UDPServer.DoAfterCacheSaved(CacheRoot: TIdDNTreeNode);
  3573. begin
  3574. if Assigned(FOnAfterCacheSaved) then begin
  3575. FOnAfterCacheSaved(CacheRoot);
  3576. end;
  3577. end;
  3578. end.