4166 lines
140 KiB
Plaintext
4166 lines
140 KiB
Plaintext
|
{
|
|||
|
|
$Project$
|
|||
|
|
$Workfile$
|
|||
|
|
$Revision$
|
|||
|
|
$DateUTC$
|
|||
|
|
$Id$
|
|||
|
|
|
|||
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|||
|
|
under the dual-licensing agreement described on the Indy website.
|
|||
|
|
(http://www.indyproject.org/)
|
|||
|
|
|
|||
|
|
Copyright:
|
|||
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|||
|
|
|
|||
|
|
|
|||
|
|
$Log$
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.40 3/4/2005 12:35:32 PM JPMugaas
|
|||
|
|
Removed some compiler warnings.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.39 2/9/2005 4:35:06 AM JPMugaas
|
|||
|
|
Should compile.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.38 2/8/05 6:13:02 PM RLebeau
|
|||
|
|
Updated to use new AppendString() function in IdGlobal unit
|
|||
|
|
|
|||
|
|
Updated TIdDNS_ProcessThread.CompleteQuery() to use CopyTId...() functions
|
|||
|
|
instead of ToBytes() and AppendBytes().
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.37 2005/1/25 <20>U<EFBFBD><55> 12:25:26 DChang
|
|||
|
|
Modify UpdateTree method, make the NS record can be save in the lower level
|
|||
|
|
node.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.36 2005/1/5 <20>U<EFBFBD><55> 04:21:06 DChang Version: 1.36
|
|||
|
|
Fix parsing procedure while processing TXT record, in pass version, double
|
|||
|
|
quota will not be processed, but now, any charector between 2 double quotas
|
|||
|
|
will be treated as TXT message.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.35 2004/12/15 <20>U<EFBFBD><55> 12:05:26 DChang Version: 1.35
|
|||
|
|
1. Move UpdateTree to public section.
|
|||
|
|
2. add DoUDPRead of TIdDNSServer.
|
|||
|
|
3. Fix TIdDNS_ProcessThread.CompleteQuery and
|
|||
|
|
InternalQuery to fit Indy 10 Core.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.34 12/2/2004 4:23:50 PM JPMugaas
|
|||
|
|
Adjusted for changes in Core.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.33 2004.10.27 9:17:46 AM czhower
|
|||
|
|
For TIdStrings
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.32 10/26/2004 9:06:32 PM JPMugaas
|
|||
|
|
Updated references.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.31 2004.10.26 1:06:26 PM czhower
|
|||
|
|
Further fixes for aliaser
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.30 2004.10.26 12:01:32 PM czhower
|
|||
|
|
Resolved alias conflict.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.29 9/15/2004 4:59:52 PM DSiders
|
|||
|
|
Added localization comments.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.28 22/07/2004 18:14:22 ANeillans
|
|||
|
|
Fixed compile error.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.27 7/21/04 2:38:04 PM RLebeau
|
|||
|
|
Removed redundant string copying in TIdDNS_ProcessThread constructor and
|
|||
|
|
procedure QueryDomain() method
|
|||
|
|
|
|||
|
|
Removed local variable from TIdDNS_ProcessThread.SendData(), not needed
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.26 2004/7/21 <20>U<EFBFBD><55> 06:37:48 DChang
|
|||
|
|
Fix compile error in TIdDNS_ProcessThread.SendData, and mark a case statment
|
|||
|
|
to comments in TIdDNS_ProcessThread.SaveToCache.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.25 2004/7/19 <20>U<EFBFBD><55> 09:55:52 DChang
|
|||
|
|
1. Move all textmoderecords to IdDNSCommon.pas
|
|||
|
|
2. Making DNS Server load the domain definition file while DNS Server
|
|||
|
|
component is active.
|
|||
|
|
3. Add a new event : OnAfterCacheSaved
|
|||
|
|
4. Add Full name condition to indicate if a domain is empty
|
|||
|
|
(ConvertDNtoString)
|
|||
|
|
5. Make Query request processed with independent thread.
|
|||
|
|
6. Rewrite TIdDNSServer into multiple thread mode, all queries will search
|
|||
|
|
and assemble the answer, and then share the TIdSocketHandle to send answer
|
|||
|
|
back.
|
|||
|
|
7. Add version information in TIdDNSServer, so class CHAOS can be taken, but
|
|||
|
|
only for the label : "version.bind.".
|
|||
|
|
8. Fix TIdRR_TXT.BinQueryRecord, to make sure it can be parsed in DNS client.
|
|||
|
|
9. Modify the AXFR function, reduce the response data size and quantity.
|
|||
|
|
10. Move all TIdTextModeResourceRecord and derived classes to IdDNSCommon.pas
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.24 7/8/04 11:43:54 PM RLebeau
|
|||
|
|
Updated TIdDNS_TCPServer.DoConnect() to use new BytesToString() parameters
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.23 7/7/04 1:45:16 PM RLebeau
|
|||
|
|
Compiler fixes
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.22 6/29/04 1:43:30 PM RLebeau
|
|||
|
|
Bug fixes for various property setters
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.21 2004.05.20 1:39:32 PM czhower
|
|||
|
|
Last of the IdStream updates
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.20 2004.03.01 9:37:06 PM czhower
|
|||
|
|
Fixed name conflicts for .net
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.19 2004.02.07 5:03:32 PM czhower
|
|||
|
|
.net fixes.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.18 2/7/2004 5:39:44 AM JPMugaas
|
|||
|
|
IdDNSServer should compile in both DotNET and WIn32.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.17 2004.02.03 5:45:58 PM czhower
|
|||
|
|
Name changes
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.16 1/22/2004 8:26:40 AM JPMugaas
|
|||
|
|
Ansi* calls changed.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.15 1/21/2004 2:12:48 PM JPMugaas
|
|||
|
|
InitComponent
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.14 12/7/2003 8:07:26 PM VVassiliev
|
|||
|
|
string -> TIdBytes
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.13 2003.10.24 10:38:24 AM czhower
|
|||
|
|
UDP Server todos
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.12 10/19/2003 12:16:30 PM DSiders
|
|||
|
|
Added localization comments.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.11 2003.10.12 3:50:40 PM czhower
|
|||
|
|
Compile todos
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.10 2003/5/14 <20>W<EFBFBD><57> 01:17:36 DChang
|
|||
|
|
Fix a flag named denoted in the function which check if a domain correct.
|
|||
|
|
Update the logic of UpdateTree functions (make them unified).
|
|||
|
|
Update the TextRecord function of all TIdRR_ classes, it checks if the RRName
|
|||
|
|
the same as FullName, if RRName = FullName, it will not append the Fullname
|
|||
|
|
to RRName.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.9 2003/5/10 <20>W<EFBFBD><57> 01:09:42 DChang
|
|||
|
|
Patch the domainlist update when axfr action.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.8 2003/5/9 <20>W<EFBFBD><57> 10:03:36 DChang
|
|||
|
|
Modify the sequence of records. To make sure when we resolve MX record, the
|
|||
|
|
mail host A record can be additional record section.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.7 2003/5/8 <20>U<EFBFBD><55> 08:11:34 DChang
|
|||
|
|
Add TIdDNSMap, TIdDomainNameServerMapping to monitor primary DNS, and
|
|||
|
|
detecting if the primary DNS record changed, it will update automatically if
|
|||
|
|
necessary.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.6 2003/5/2 <20>U<EFBFBD><55> 03:39:38 DChang
|
|||
|
|
Fix all compile warnings and hints.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.5 4/29/2003 08:26:30 PM DenniesChang
|
|||
|
|
Fix TIdDNSServer Create, the older version miss to create the FBindings.
|
|||
|
|
fix AXFR procedure, fully support BIND 8 AXFR procedures.
|
|||
|
|
|
|||
|
|
Rev 1.4 4/28/2003 02:30:58 PM JPMugaas
|
|||
|
|
reverted back to the old one as the new one checked will not compile, has
|
|||
|
|
problametic dependancies on Contrs and Dialogs (both not permitted).
|
|||
|
|
|
|||
|
|
Rev 1.3 04/28/2003 01:15:10 AM DenniesChang
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.2 4/28/2003 07:00:18 AM JPMugaas
|
|||
|
|
Should now compile.
|
|||
|
|
|
|||
|
|
|
|||
|
|
Rev 1.0 11/14/2002 02:18:42 PM JPMugaas
|
|||
|
|
|
|||
|
|
// Ver: 2003-04-28-0115
|
|||
|
|
// Combine TCP, UDP Tunnel into single TIdDNSServer component.
|
|||
|
|
// Update TIdDNSServer from TIdUDPServer to TComponent.
|
|||
|
|
|
|||
|
|
// Ver: 2003-04-26-1810
|
|||
|
|
// Add AXFR command.
|
|||
|
|
|
|||
|
|
// Ver: 2002-10-30-1253
|
|||
|
|
// Add TIdRR_AAAA class, RFC 1884 (Ipv6 AAAA)
|
|||
|
|
// and add the coresponding fix in TIdDNSServer, but left
|
|||
|
|
// external search option for future.
|
|||
|
|
|
|||
|
|
// Ver: 2002-07-10-1610
|
|||
|
|
// Add a new event : OnAfterSendBack to handle all
|
|||
|
|
// data logged after query result is sent back to
|
|||
|
|
// the client.
|
|||
|
|
|
|||
|
|
// Ver: 2002-05-27-0910
|
|||
|
|
// Add a check function in SOA loading function.
|
|||
|
|
|
|||
|
|
// Ver: 2002-04-25-1530
|
|||
|
|
// IdDNSServer. Ver: 2002-03-12-0900
|
|||
|
|
|
|||
|
|
|
|||
|
|
// To-do: RFC 2136 Zone transfer must be implemented.
|
|||
|
|
|
|||
|
|
|
|||
|
|
// Add FindHandedNodeByName to pass the TIdDNTreeNode Object back.
|
|||
|
|
// Append a blank char when ClearQuota, to avoid the possible of
|
|||
|
|
// losting a field.
|
|||
|
|
// Add IdDNTree.SaveToFile
|
|||
|
|
// Fix SOA RRName assignment.
|
|||
|
|
// Fix PTRName RRName assignment.
|
|||
|
|
// Fix TIdDNTreeNode RemoveChild
|
|||
|
|
|
|||
|
|
// IdDNSServer. Ver: 2002-02-26-1420
|
|||
|
|
// Convert the DN Tree Node type, earlier verison just
|
|||
|
|
// store the A, PTR in the upper domain node, current
|
|||
|
|
// version save SOA and its subdomain in upper node.
|
|||
|
|
//
|
|||
|
|
// Moreover, move Cached_Tree, Handed_Tree to public
|
|||
|
|
// section, for using convinent.
|
|||
|
|
//
|
|||
|
|
// I forget return CName data, fixed.
|
|||
|
|
// Seperate the seaching of Cache and handled tree into 2
|
|||
|
|
// parts with a flag.
|
|||
|
|
|
|||
|
|
|
|||
|
|
//IdDNSServer. Ver: 2002-02-24-1715
|
|||
|
|
// Move TIdDNSServer protected property RootDNS_NET to public
|
|||
|
|
|
|||
|
|
|
|||
|
|
//IdDNSServer. Ver: 2002-02-23-1800
|
|||
|
|
|
|||
|
|
Original Programmer: Dennies Chang <dennies@ms4.hinet.net>
|
|||
|
|
No Copyright. Code is given to the Indy Pit Crew.
|
|||
|
|
|
|||
|
|
This DNS Server supports only IN record, but not Chaos system.
|
|||
|
|
Most of resource records in DNS server was stored with text mode,
|
|||
|
|
event the TREE structure, it's just for convininet.
|
|||
|
|
|
|||
|
|
Why I did it with this way is tring to increase the speed for
|
|||
|
|
implementation, with Delphi/Kylix internal class and object,
|
|||
|
|
we can promise the compatible in Windows and Linux.
|
|||
|
|
|
|||
|
|
Started: Jan. 20, 2002.
|
|||
|
|
First Finished: Feb. 23, 2002.
|
|||
|
|
|
|||
|
|
RFC 1035 WKS record is not implemented.
|
|||
|
|
|
|||
|
|
ToDO: Load Master File automaticlly when DNS Server Active.
|
|||
|
|
ToDO: patch WKS record data type.
|
|||
|
|
ToDO: prepare a Tree Editor for DNS Server Construction. (optional)
|
|||
|
|
}
|
|||
|
|
unit IdDNSServer;
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
{$i IdCompilerDefines.inc}
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
Classes,
|
|||
|
|
IdContainers,
|
|||
|
|
IdAssignedNumbers,
|
|||
|
|
IdSocketHandle,
|
|||
|
|
IdIOHandlerSocket,
|
|||
|
|
IdGlobal,
|
|||
|
|
IdGlobalProtocols,
|
|||
|
|
IdBaseComponent,
|
|||
|
|
IdComponent,
|
|||
|
|
IdContext,
|
|||
|
|
IdUDPBase,
|
|||
|
|
IdResourceStrings,
|
|||
|
|
IdExceptionCore,
|
|||
|
|
IdDNSResolver,
|
|||
|
|
IdUDPServer,
|
|||
|
|
IdCustomTCPServer,
|
|||
|
|
IdStackConsts,
|
|||
|
|
IdThread,
|
|||
|
|
IdDNSCommon;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TIdDomainExpireCheckThread = class(TIdThread)
|
|||
|
|
protected
|
|||
|
|
FInterval: UInt32;
|
|||
|
|
FSender: TObject;
|
|||
|
|
FTimerEvent: TNotifyEvent;
|
|||
|
|
FBusy : Boolean;
|
|||
|
|
FDomain : string;
|
|||
|
|
FHost : string;
|
|||
|
|
//
|
|||
|
|
procedure Run; override;
|
|||
|
|
procedure TimerEvent;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// forward declaration.
|
|||
|
|
TIdDNSMap = class;
|
|||
|
|
TIdDNS_UDPServer = class;
|
|||
|
|
|
|||
|
|
// This class is to record the mapping of Domain and its primary DNS IP
|
|||
|
|
TIdDomainNameServerMapping = class(TObject)
|
|||
|
|
private
|
|||
|
|
FHost: string;
|
|||
|
|
FDomainName: string;
|
|||
|
|
FBusy : Boolean;
|
|||
|
|
FInterval: UInt32;
|
|||
|
|
FList: TIdDNSMap;
|
|||
|
|
procedure SetHost(const Value: string);
|
|||
|
|
procedure SetInterval(const Value: UInt32);
|
|||
|
|
protected
|
|||
|
|
CheckScheduler : TIdDomainExpireCheckThread;
|
|||
|
|
property Interval : UInt32 read FInterval write SetInterval;
|
|||
|
|
property List : TIdDNSMap read FList write FList;
|
|||
|
|
public
|
|||
|
|
constructor Create(AList : TIdDNSMap);
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
//You can not make methods and properties published in this class.
|
|||
|
|
//If you want to make properties publishes, this has to derrive from TPersistant
|
|||
|
|
//and be used by TPersistant in a published property.
|
|||
|
|
// published
|
|||
|
|
procedure SyncAndUpdate(Sender : TObject);
|
|||
|
|
property Host : string read FHost write SetHost;
|
|||
|
|
property DomainName : string read FDomainName write FDomainName;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdDNSMap = class(TIdObjectList{$IFDEF HAS_GENERICS_TObjectList}<TIdDomainNameServerMapping>{$ENDIF})
|
|||
|
|
private
|
|||
|
|
FServer: TIdDNS_UDPServer;
|
|||
|
|
{$IFNDEF HAS_GENERICS_TObjectList}
|
|||
|
|
function GetItem(Index: Integer): TIdDomainNameServerMapping;
|
|||
|
|
procedure SetItem(Index: Integer; const Value: TIdDomainNameServerMapping);
|
|||
|
|
{$ENDIF}
|
|||
|
|
procedure SetServer(const Value: TIdDNS_UDPServer);
|
|||
|
|
public
|
|||
|
|
constructor Create(Server: TIdDNS_UDPServer);
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
{$ENDIF}
|
|||
|
|
property Server : TIdDNS_UDPServer read FServer write SetServer;
|
|||
|
|
{$IFNDEF HAS_GENERICS_TObjectList}
|
|||
|
|
property Items[Index: Integer]: TIdDomainNameServerMapping read GetItem write SetItem; default;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdMWayTreeNodeClass = class of TIdMWayTreeNode;
|
|||
|
|
// TODO: derive from TObjectList instead and remove SubTree member?
|
|||
|
|
TIdMWayTreeNode = class(TObject)
|
|||
|
|
private
|
|||
|
|
SubTree : TIdObjectList{$IFDEF HAS_GENERICS_TObjectList}<TIdMWayTreeNode>{$ENDIF};
|
|||
|
|
FFundmentalClass: TIdMWayTreeNodeClass;
|
|||
|
|
function GetTreeNode(Index: Integer): TIdMWayTreeNode;
|
|||
|
|
procedure SetFundmentalClass(const Value: TIdMWayTreeNodeClass);
|
|||
|
|
procedure SetTreeNode(Index: Integer; const Value: TIdMWayTreeNode);
|
|||
|
|
public
|
|||
|
|
constructor Create(NodeClass : TIdMWayTreeNodeClass); virtual;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
property FundmentalClass : TIdMWayTreeNodeClass read FFundmentalClass write SetFundmentalClass;
|
|||
|
|
property Children[Index : Integer] : TIdMWayTreeNode read GetTreeNode write SetTreeNode;
|
|||
|
|
function AddChild : TIdMWayTreeNode;
|
|||
|
|
function InsertChild(Index : Integer) : TIdMWayTreeNode;
|
|||
|
|
procedure RemoveChild(Index : Integer);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdDNTreeNode = class(TIdMWayTreeNode)
|
|||
|
|
private
|
|||
|
|
FCLabel : String;
|
|||
|
|
FRRs: TIdTextModeRRs;
|
|||
|
|
FChildIndex: TStrings;
|
|||
|
|
FParentNode: TIdDNTreeNode;
|
|||
|
|
FAutoSortChild: Boolean;
|
|||
|
|
procedure SetCLabel(const Value: String);
|
|||
|
|
procedure SetRRs(const Value: TIdTextModeRRs);
|
|||
|
|
function GetNode(Index: integer): TIdDNTreeNode;
|
|||
|
|
procedure SetNode(Index: integer; const Value: TIdDNTreeNode);
|
|||
|
|
procedure SetChildIndex(const Value: TStrings);
|
|||
|
|
function GetFullName: string;
|
|||
|
|
function ConvertToDNString : string;
|
|||
|
|
function DumpAllBinaryData(var RecordCount:integer) : TIdBytes;
|
|||
|
|
public
|
|||
|
|
property ParentNode : TIdDNTreeNode read FParentNode write FParentNode;
|
|||
|
|
property CLabel : String read FCLabel write SetCLabel;
|
|||
|
|
property RRs : TIdTextModeRRs read FRRs write SetRRs;
|
|||
|
|
property Children[Index : Integer] : TIdDNTreeNode read GetNode write SetNode;
|
|||
|
|
property ChildIndex : TStrings read FChildIndex write SetChildIndex;
|
|||
|
|
property AutoSortChild : Boolean read FAutoSortChild write FAutoSortChild;
|
|||
|
|
property FullName : string read GetFullName;
|
|||
|
|
|
|||
|
|
constructor Create(AParentNode : TIdDNTreeNode); reintroduce;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
function AddChild : TIdDNTreeNode;
|
|||
|
|
function InsertChild(Index : Integer) : TIdDNTreeNode;
|
|||
|
|
procedure RemoveChild(Index : Integer);
|
|||
|
|
procedure SortChildren;
|
|||
|
|
procedure Clear;
|
|||
|
|
procedure SaveToFile(Filename : String);
|
|||
|
|
function IndexByLabel(CLabel : String): Integer;
|
|||
|
|
function IndexByNode(ANode : TIdDNTreeNode) : Integer;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdDNS_TCPServer = class(TIdCustomTCPServer)
|
|||
|
|
protected
|
|||
|
|
FAccessList: TStrings;
|
|||
|
|
FAccessControl: Boolean;
|
|||
|
|
//
|
|||
|
|
procedure DoConnect(AContext: TIdContext); override;
|
|||
|
|
procedure InitComponent; override;
|
|||
|
|
procedure SetAccessList(const Value: TStrings);
|
|||
|
|
public
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
published
|
|||
|
|
property AccessList : TStrings read FAccessList write SetAccessList;
|
|||
|
|
property AccessControl : boolean read FAccessControl write FAccessControl;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdDNS_ProcessThread = class(TIdThread)
|
|||
|
|
protected
|
|||
|
|
FMyBinding: TIdSocketHandle;
|
|||
|
|
FMainBinding: TIdSocketHandle;
|
|||
|
|
FMyData: TStream;
|
|||
|
|
FData : TIdBytes;
|
|||
|
|
FServer: TIdDNS_UDPServer;
|
|||
|
|
procedure SetMyBinding(const Value: TIdSocketHandle);
|
|||
|
|
procedure SetMyData(const Value: TStream);
|
|||
|
|
procedure SetServer(const Value: TIdDNS_UDPServer);
|
|||
|
|
procedure ComposeErrorResult(var VFinal: TIdBytes; OriginalHeader: TDNSHeader;
|
|||
|
|
OriginalQuestion : TIdBytes; ErrorStatus: Integer);
|
|||
|
|
function CombineAnswer(Header : TDNSHeader; const EQuery, Answer : TIdBytes): TIdBytes;
|
|||
|
|
procedure InternalSearch(Header: TDNSHeader; QName: string; QType: UInt16;
|
|||
|
|
var Answer: TIdBytes; IfMainQuestion: Boolean; IsSearchCache: Boolean = False;
|
|||
|
|
IsAdditional: Boolean = False; IsWildCard : Boolean = False;
|
|||
|
|
WildCardOrgName: string = '');
|
|||
|
|
procedure ExternalSearch(ADNSResolver: TIdDNSResolver; Header: TDNSHeader;
|
|||
|
|
Question: TIdBytes; var Answer: TIdBytes);
|
|||
|
|
function CompleteQuery(DNSHeader: TDNSHeader; Question: string;
|
|||
|
|
OriginalQuestion: TIdBytes; var Answer : TIdBytes; QType, QClass : UInt16;
|
|||
|
|
DNSResolver : TIdDNSResolver) : string;
|
|||
|
|
procedure SaveToCache(ResourceRecord : TIdBytes; QueryName : string; OriginalQType : UInt16);
|
|||
|
|
function SearchTree(Root : TIdDNTreeNode; QName : String; QType : UInt16): TIdDNTreeNode;
|
|||
|
|
|
|||
|
|
procedure Run; override;
|
|||
|
|
procedure QueryDomain;
|
|||
|
|
procedure SendData;
|
|||
|
|
public
|
|||
|
|
property MyBinding : TIdSocketHandle read FMyBinding write SetMyBinding;
|
|||
|
|
property MyData: TStream read FMyData write SetMyData;
|
|||
|
|
property Server : TIdDNS_UDPServer read FServer write SetServer;
|
|||
|
|
|
|||
|
|
constructor Create(ACreateSuspended: Boolean = True; Data : TIdBytes = nil;
|
|||
|
|
MainBinding : TIdSocketHandle = nil; Binding : TIdSocketHandle = nil;
|
|||
|
|
Server : TIdDNS_UDPServer = nil); reintroduce; overload;
|
|||
|
|
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdDNSBeforeQueryEvent = procedure(ABinding: TIdSocketHandle; ADNSHeader: TDNSHeader; var ADNSQuery: TIdBytes) of object;
|
|||
|
|
TIdDNSAfterQueryEvent = procedure(ABinding: TIdSocketHandle; ADNSHeader: TDNSHeader; var QueryResult: TIdBytes; var ResultCode: string; Query : TIdBytes) of object;
|
|||
|
|
TIdDNSAfterCacheSaved = procedure(CacheRoot : TIdDNTreeNode) of object;
|
|||
|
|
|
|||
|
|
TIdDNS_UDPServer = class(TIdUDPServer)
|
|||
|
|
private
|
|||
|
|
FBusy: Boolean;
|
|||
|
|
protected
|
|||
|
|
FAutoUpdateZoneInfo: Boolean;
|
|||
|
|
FZoneMasterFiles: TStrings;
|
|||
|
|
FRootDNS_NET: TStrings;
|
|||
|
|
FCacheUnknowZone: Boolean;
|
|||
|
|
FCached_Tree: TIdDNTreeNode;
|
|||
|
|
FHanded_Tree: TIdDNTreeNode;
|
|||
|
|
FHanded_DomainList: TStrings;
|
|||
|
|
FAutoLoadMasterFile: Boolean;
|
|||
|
|
FOnAfterQuery: TIdDNSAfterQueryEvent;
|
|||
|
|
FOnBeforeQuery: TIdDNSBeforeQueryEvent;
|
|||
|
|
FCS: TIdCriticalSection;
|
|||
|
|
FOnAfterSendBack: TIdDNSAfterQueryEvent;
|
|||
|
|
FOnAfterCacheSaved: TIdDNSAfterCacheSaved;
|
|||
|
|
FGlobalCS: TIdCriticalSection;
|
|||
|
|
FDNSVersion: string;
|
|||
|
|
FofferDNSVersion: Boolean;
|
|||
|
|
|
|||
|
|
procedure DoBeforeQuery(ABinding: TIdSocketHandle; ADNSHeader: TDNSHeader;
|
|||
|
|
var ADNSQuery : TIdBytes); dynamic;
|
|||
|
|
|
|||
|
|
procedure DoAfterQuery(ABinding: TIdSocketHandle; ADNSHeader: TDNSHeader;
|
|||
|
|
var QueryResult : TIdBytes; var ResultCode : String; Query : TIdBytes); dynamic;
|
|||
|
|
|
|||
|
|
procedure DoAfterSendBack(ABinding: TIdSocketHandle; ADNSHeader: TDNSHeader;
|
|||
|
|
var QueryResult : TIdBytes; var ResultCode : String; Query : TIdBytes); dynamic;
|
|||
|
|
|
|||
|
|
procedure DoAfterCacheSaved(CacheRoot : TIdDNTreeNode); dynamic;
|
|||
|
|
|
|||
|
|
procedure SetZoneMasterFiles(const Value: TStrings);
|
|||
|
|
procedure SetRootDNS_NET(const Value: TStrings);
|
|||
|
|
procedure SetHanded_DomainList(const Value: TStrings);
|
|||
|
|
procedure InternalSearch(Header: TDNSHeader; QName: string; QType: UInt16;
|
|||
|
|
var Answer: TIdBytes; IfMainQuestion: boolean; IsSearchCache: Boolean = False;
|
|||
|
|
IsAdditional: Boolean = False; IsWildCard : Boolean = False;
|
|||
|
|
WildCardOrgName: string = '');
|
|||
|
|
procedure ExternalSearch(ADNSResolver: TIdDNSResolver; Header: TDNSHeader;
|
|||
|
|
Question: TIdBytes; var Answer: TIdBytes);
|
|||
|
|
//modified in May 2004 by Dennies Chang.
|
|||
|
|
//procedure SaveToCache(ResourceRecord : string);
|
|||
|
|
procedure SaveToCache(ResourceRecord : TIdBytes; QueryName : string; OriginalQType : UInt16);
|
|||
|
|
//procedure UpdateTree(TreeRoot : TIdDNTreeNode; RR : TResultRecord); overload;
|
|||
|
|
//MoveTo Public section for RaidenDNSD.
|
|||
|
|
|
|||
|
|
procedure InitComponent; override;
|
|||
|
|
// Hide this property temporily, this property is prepared to maintain the
|
|||
|
|
// TTL expired record auto updated;
|
|||
|
|
property AutoUpdateZoneInfo : boolean read FAutoUpdateZoneInfo write FAutoUpdateZoneInfo;
|
|||
|
|
property CS: TIdCriticalSection read FCS;
|
|||
|
|
procedure DoUDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle); override;
|
|||
|
|
public
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
function AXFR(Header : TDNSHeader; Question : string; var Answer : TIdBytes) : string;
|
|||
|
|
function CompleteQuery(DNSHeader: TDNSHeader; Question: string;
|
|||
|
|
OriginalQuestion: TIdBytes; var Answer : TIdBytes; QType, QClass : UInt16;
|
|||
|
|
DNSResolver : TIdDNSResolver) : string; {$IFDEF HAS_DEPRECATED}deprecated;{$ENDIF}
|
|||
|
|
function LoadZoneFromMasterFile(MasterFileName : String) : boolean;
|
|||
|
|
function LoadZoneStrings(FileStrings: TStrings; Filename : String;
|
|||
|
|
TreeRoot : TIdDNTreeNode): Boolean;
|
|||
|
|
function SearchTree(Root : TIdDNTreeNode; QName : String; QType : UInt16): TIdDNTreeNode;
|
|||
|
|
procedure UpdateTree(TreeRoot : TIdDNTreeNode; RR : TIdTextModeResourceRecord); overload;
|
|||
|
|
function FindNodeFullName(Root : TIdDNTreeNode; QName : String; QType : UInt16) : string;
|
|||
|
|
function FindHandedNodeByName(QName : String; QType : UInt16) : TIdDNTreeNode;
|
|||
|
|
procedure UpdateTree(TreeRoot : TIdDNTreeNode; RR : TResultRecord); overload;
|
|||
|
|
|
|||
|
|
property RootDNS_NET : TStrings read FRootDNS_NET write SetRootDNS_NET;
|
|||
|
|
property Cached_Tree : TIdDNTreeNode read FCached_Tree {write SetCached_Tree};
|
|||
|
|
property Handed_Tree : TIdDNTreeNode read FHanded_Tree {write SetHanded_Tree};
|
|||
|
|
property Busy : Boolean read FBusy;
|
|||
|
|
property GlobalCS : TIdCriticalSection read FGlobalCS;
|
|||
|
|
published
|
|||
|
|
property DefaultPort default IdPORT_DOMAIN;
|
|||
|
|
property AutoLoadMasterFile : Boolean read FAutoLoadMasterFile write FAutoLoadMasterFile Default False;
|
|||
|
|
|
|||
|
|
//property AutoUpdateZoneInfo : boolean read FAutoUpdateZoneInfo write SetAutoUpdateZoneInfo;
|
|||
|
|
property ZoneMasterFiles : TStrings read FZoneMasterFiles write SetZoneMasterFiles;
|
|||
|
|
property CacheUnknowZone : Boolean read FCacheUnknowZone write FCacheUnknowZone default False;
|
|||
|
|
property Handed_DomainList : TStrings read FHanded_DomainList write SetHanded_DomainList;
|
|||
|
|
property DNSVersion : string read FDNSVersion write FDNSVersion;
|
|||
|
|
property offerDNSVersion : Boolean read FofferDNSVersion write FofferDNSVersion;
|
|||
|
|
|
|||
|
|
property OnBeforeQuery : TIdDNSBeforeQueryEvent read FOnBeforeQuery write FOnBeforeQuery;
|
|||
|
|
property OnAfterQuery : TIdDNSAfterQueryEvent read FOnAfterQuery write FOnAfterQuery;
|
|||
|
|
property OnAfterSendBack : TIdDNSAfterQueryEvent read FOnAfterSendBack write FOnAfterSendBack;
|
|||
|
|
property OnAfterCacheSaved : TIdDNSAfterCacheSaved read FOnAfterCacheSaved write FOnAfterCacheSaved;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TIdDNSServer = class(TIdComponent)
|
|||
|
|
protected
|
|||
|
|
FActive: Boolean;
|
|||
|
|
FTCPACLActive: Boolean;
|
|||
|
|
FServerType: TDNSServerTypes;
|
|||
|
|
FTCPTunnel: TIdDNS_TCPServer;
|
|||
|
|
FUDPTunnel: TIdDNS_UDPServer;
|
|||
|
|
FAccessList: TStrings;
|
|||
|
|
FBindings: TIdSocketHandles;
|
|||
|
|
procedure SetAccessList(const Value: TStrings);
|
|||
|
|
procedure SetActive(const Value: Boolean);
|
|||
|
|
procedure SetTCPACLActive(const Value: Boolean);
|
|||
|
|
procedure SetBindings(const Value: TIdSocketHandles);
|
|||
|
|
procedure TimeToUpdateNodeData(Sender : TObject);
|
|||
|
|
procedure InitComponent; override;
|
|||
|
|
public
|
|||
|
|
BackupDNSMap : TIdDNSMap;
|
|||
|
|
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
procedure CheckIfExpire(Sender: TObject);
|
|||
|
|
published
|
|||
|
|
property Active : Boolean read FActive write SetActive;
|
|||
|
|
property AccessList : TStrings read FAccessList write SetAccessList;
|
|||
|
|
property Bindings: TIdSocketHandles read FBindings write SetBindings;
|
|||
|
|
|
|||
|
|
property TCPACLActive : Boolean read FTCPACLActive write SetTCPACLActive;
|
|||
|
|
property ServerType: TDNSServerTypes read FServerType write FServerType;
|
|||
|
|
property TCPTunnel : TIdDNS_TCPServer read FTCPTunnel write FTCPTunnel;
|
|||
|
|
property UDPTunnel : TIdDNS_UDPServer read FUDPTunnel write FUDPTunnel;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
{$IFDEF VCL_XE3_OR_ABOVE}
|
|||
|
|
{$IFNDEF NEXTGEN}
|
|||
|
|
System.Contnrs,
|
|||
|
|
{$ENDIF}
|
|||
|
|
System.SyncObjs,
|
|||
|
|
System.Types,
|
|||
|
|
{$ENDIF}
|
|||
|
|
IdException,
|
|||
|
|
{$IFDEF DOTNET}
|
|||
|
|
{$IFDEF USE_INLINE}
|
|||
|
|
System.Threading,
|
|||
|
|
System.IO,
|
|||
|
|
{$ENDIF}
|
|||
|
|
{$ENDIF}
|
|||
|
|
{$IFDEF USE_VCL_POSIX}
|
|||
|
|
Posix.SysSelect,
|
|||
|
|
Posix.SysTime,
|
|||
|
|
{$ENDIF}
|
|||
|
|
IdIOHandler,
|
|||
|
|
IdStack,
|
|||
|
|
SysUtils;
|
|||
|
|
|
|||
|
|
{Common Utilities}
|
|||
|
|
|
|||
|
|
function CompareItems(Item1, Item2: {$IFDEF HAS_GENERICS_TObjectList}TIdMWayTreeNode{$ELSE}TObject{$ENDIF}): Integer;
|
|||
|
|
var
|
|||
|
|
LObj1, LObj2 : TIdDNTreeNode;
|
|||
|
|
begin
|
|||
|
|
LObj1 := Item1 as TIdDNTreeNode;
|
|||
|
|
LObj2 := Item2 as TIdDNTreeNode;
|
|||
|
|
Result := CompareStr(LObj1.CLabel, LObj2.CLabel);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// TODO: move to IdGlobal.pas
|
|||
|
|
function PosBytes(const SubBytes, SBytes: TIdBytes): Integer;
|
|||
|
|
var
|
|||
|
|
LSubLen, LBytesLen, I: Integer;
|
|||
|
|
begin
|
|||
|
|
LSubLen := Length(SubBytes);
|
|||
|
|
LBytesLen := Length(SBytes);
|
|||
|
|
if (LSubLen > 0) and (LBytesLen >= LSubLen) then
|
|||
|
|
begin
|
|||
|
|
for Result := 0 to LBytesLen-LSubLen do
|
|||
|
|
begin
|
|||
|
|
if SBytes[Result] = SubBytes[0] then
|
|||
|
|
begin
|
|||
|
|
for I := 1 to LSubLen-1 do
|
|||
|
|
begin
|
|||
|
|
if SBytes[Result+I] <> SubBytes[I] then begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
if I = LSubLen then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Result := -1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// TODO: move to IdGlobal.pas
|
|||
|
|
function FetchBytes(var AInput: TIdBytes; const ADelim: TIdBytes;
|
|||
|
|
const ADelete: Boolean = IdFetchDeleteDefault): TIdBytes;
|
|||
|
|
var
|
|||
|
|
LPos: integer;
|
|||
|
|
begin
|
|||
|
|
LPos := PosBytes(ADelim, AInput);
|
|||
|
|
if LPos = -1 then begin
|
|||
|
|
Result := AInput;
|
|||
|
|
if ADelete then begin
|
|||
|
|
SetLength(AInput, 0);
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
Result := ToBytes(AInput, LPos);
|
|||
|
|
if ADelete then begin
|
|||
|
|
//slower Delete(AInput, 1, LPos + Length(ADelim) - 1);
|
|||
|
|
RemoveBytes(AInput, LPos + Length(ADelim));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdMWayTreeNode }
|
|||
|
|
|
|||
|
|
function TIdMWayTreeNode.AddChild: TIdMWayTreeNode;
|
|||
|
|
begin
|
|||
|
|
Result := FundmentalClass.Create(FundmentalClass);
|
|||
|
|
try
|
|||
|
|
SubTree.Add(Result);
|
|||
|
|
except
|
|||
|
|
FreeAndNil(Result);
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
constructor TIdMWayTreeNode.Create(NodeClass : TIdMWayTreeNodeClass);
|
|||
|
|
begin
|
|||
|
|
inherited Create;
|
|||
|
|
FundmentalClass := NodeClass;
|
|||
|
|
SubTree := TIdObjectList{$IFDEF HAS_GENERICS_TObjectList}<TIdMWayTreeNode>{$ENDIF}.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdMWayTreeNode.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(SubTree);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdMWayTreeNode.GetTreeNode(Index: Integer): TIdMWayTreeNode;
|
|||
|
|
begin
|
|||
|
|
Result := {$IFDEF HAS_GENERICS_TObjectList}SubTree.Items[Index]{$ELSE}TIdMWayTreeNode(SubTree.Items[Index]){$ENDIF};
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdMWayTreeNode.InsertChild(Index: Integer): TIdMWayTreeNode;
|
|||
|
|
begin
|
|||
|
|
Result := FundmentalClass.Create(FundmentalClass);
|
|||
|
|
try
|
|||
|
|
SubTree.Insert(Index, Result);
|
|||
|
|
except
|
|||
|
|
FreeAndNil(Result);
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdMWayTreeNode.RemoveChild(Index: Integer);
|
|||
|
|
begin
|
|||
|
|
SubTree.Delete(Index);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdMWayTreeNode.SetFundmentalClass(const Value: TIdMWayTreeNodeClass);
|
|||
|
|
begin
|
|||
|
|
FFundmentalClass := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdMWayTreeNode.SetTreeNode(Index: Integer; const Value: TIdMWayTreeNode);
|
|||
|
|
begin
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
SubTree.Items[Index].Free;
|
|||
|
|
{$ENDIF}
|
|||
|
|
SubTree.Items[Index] := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDNTreeNode }
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.AddChild: TIdDNTreeNode;
|
|||
|
|
begin
|
|||
|
|
Result := TIdDNTreeNode.Create(Self);
|
|||
|
|
try
|
|||
|
|
SubTree.Add(Result);
|
|||
|
|
except
|
|||
|
|
FreeAndNil(Result);
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.Clear;
|
|||
|
|
var
|
|||
|
|
I : Integer;
|
|||
|
|
begin
|
|||
|
|
for I := SubTree.Count - 1 downto 0 do begin
|
|||
|
|
RemoveChild(I);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.ConvertToDNString: string;
|
|||
|
|
var
|
|||
|
|
Count : Integer;
|
|||
|
|
begin
|
|||
|
|
Result := '$ORIGIN ' + FullName + EOL; {do not localize}
|
|||
|
|
|
|||
|
|
for Count := 0 to RRs.Count-1 do begin
|
|||
|
|
Result := Result + RRs.Items[Count].TextRecord(FullName);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
for Count := 0 to FChildIndex.Count-1 do begin
|
|||
|
|
Result := Result + Children[Count].ConvertToDNString;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
constructor TIdDNTreeNode.Create(AParentNode : TIdDNTreeNode);
|
|||
|
|
begin
|
|||
|
|
inherited Create(TIdDNTreeNode);
|
|||
|
|
FRRs := TIdTextModeRRs.Create;
|
|||
|
|
FChildIndex := TStringList.Create;
|
|||
|
|
FParentNode := AParentNode;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdDNTreeNode.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FRRs);
|
|||
|
|
FreeAndNil(FChildIndex);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.DumpAllBinaryData(var RecordCount: Integer): TIdBytes;
|
|||
|
|
var
|
|||
|
|
Count, ChildCount : integer;
|
|||
|
|
MyString, ChildString : TIdBytes;
|
|||
|
|
begin
|
|||
|
|
SetLength(ChildString, 0);
|
|||
|
|
SetLength(MyString, 0);
|
|||
|
|
Inc(RecordCount, RRs.Count + 1);
|
|||
|
|
|
|||
|
|
for Count := 0 to RRs.Count -1 do
|
|||
|
|
begin
|
|||
|
|
AppendBytes(MyString, RRs.Items[Count].BinQueryRecord(FullName));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
for Count := 0 to FChildIndex.Count -1 do
|
|||
|
|
begin
|
|||
|
|
// RLebeau: should ChildCount be set to 0 each time?
|
|||
|
|
AppendBytes(ChildString, Children[Count].DumpAllBinaryData(ChildCount));
|
|||
|
|
Inc(RecordCount, ChildCount);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if RRs.Count > 0 then begin
|
|||
|
|
if RRs.Items[0] is TIdRR_SOA then begin
|
|||
|
|
AppendBytes(MyString, RRs.Items[0].BinQueryRecord(FullName));
|
|||
|
|
Inc(RecordCount);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Result := MyString;
|
|||
|
|
AppendBytes(Result, ChildString);
|
|||
|
|
|
|||
|
|
if RRs.Count > 0 then begin
|
|||
|
|
AppendBytes(Result, RRs.Items[0].BinQueryRecord(FullName));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.GetFullName: string;
|
|||
|
|
begin
|
|||
|
|
if ParentNode = nil then begin
|
|||
|
|
if CLabel = '.' then begin
|
|||
|
|
Result := '';
|
|||
|
|
end else begin
|
|||
|
|
Result := CLabel;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Result := CLabel + '.' + ParentNode.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.GetNode(Index: Integer): TIdDNTreeNode;
|
|||
|
|
begin
|
|||
|
|
Result := TIdDNTreeNode(SubTree.Items[Index]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.IndexByLabel(CLabel: String): Integer;
|
|||
|
|
begin
|
|||
|
|
Result := FChildIndex.IndexOf(CLabel);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.IndexByNode(ANode: TIdDNTreeNode): Integer;
|
|||
|
|
begin
|
|||
|
|
Result := SubTree.IndexOf(ANode);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNTreeNode.InsertChild(Index: Integer): TIdDNTreeNode;
|
|||
|
|
begin
|
|||
|
|
Result := TIdDNTreeNode.Create(Self);
|
|||
|
|
try
|
|||
|
|
SubTree.Insert(Index, Result);
|
|||
|
|
except
|
|||
|
|
FreeAndNil(Result);
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.RemoveChild(Index: Integer);
|
|||
|
|
begin
|
|||
|
|
SubTree.Remove(SubTree.Items[Index]);
|
|||
|
|
FChildIndex.Delete(Index);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.SaveToFile(Filename: String);
|
|||
|
|
var
|
|||
|
|
DNSs : TStrings;
|
|||
|
|
begin
|
|||
|
|
DNSs := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
DNSs.Add(ConvertToDNString);
|
|||
|
|
ToDo('SaveToFile() method of TIdDNTreeNode class is not implemented yet'); {do not localized}
|
|||
|
|
// DNSs.SaveToFile(Filename);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(DNSs);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.SetChildIndex(const Value: TStrings);
|
|||
|
|
begin
|
|||
|
|
FChildIndex.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.SetCLabel(const Value: String);
|
|||
|
|
begin
|
|||
|
|
FCLabel := Value;
|
|||
|
|
if ParentNode <> nil then begin
|
|||
|
|
ParentNode.ChildIndex.Insert(ParentNode.SubTree.IndexOf(Self), Value);
|
|||
|
|
end;
|
|||
|
|
if AutoSortChild then begin
|
|||
|
|
SortChildren;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.SetNode(Index: Integer; const Value: TIdDNTreeNode);
|
|||
|
|
begin
|
|||
|
|
SubTree.Items[Index] := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.SetRRs(const Value: TIdTextModeRRs);
|
|||
|
|
begin
|
|||
|
|
FRRs.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNTreeNode.SortChildren;
|
|||
|
|
begin
|
|||
|
|
SubTree.BubbleSort(CompareItems);
|
|||
|
|
TStringList(FChildIndex).Sort;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDNSServer }
|
|||
|
|
|
|||
|
|
{$I IdDeprecatedImplBugOff.inc}
|
|||
|
|
function TIdDNS_UDPServer.CompleteQuery(DNSHeader : TDNSHeader; Question: string;
|
|||
|
|
OriginalQuestion: TIdBytes; var Answer: TIdBytes; QType, QClass: UInt16;
|
|||
|
|
DNSResolver : TIdDNSResolver): string;
|
|||
|
|
{$I IdDeprecatedImplBugOn.inc}
|
|||
|
|
var
|
|||
|
|
IsMyDomains : Boolean;
|
|||
|
|
LAnswer: TIdBytes;
|
|||
|
|
WildQuestion, TempDomain : string;
|
|||
|
|
begin
|
|||
|
|
// QClass = 1 => IN, we support only "IN" class now.
|
|||
|
|
// QClass = 2 => CS,
|
|||
|
|
// QClass = 3 => CH,
|
|||
|
|
// QClass = 4 => HS.
|
|||
|
|
|
|||
|
|
if QClass <> 1 then begin
|
|||
|
|
Result := cRCodeQueryNotImplement;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TempDomain := LowerCase(Question);
|
|||
|
|
IsMyDomains := (Handed_DomainList.IndexOf(TempDomain) > -1);
|
|||
|
|
if not IsMyDomains then begin
|
|||
|
|
Fetch(TempDomain, '.');
|
|||
|
|
IsMyDomains := (Handed_DomainList.IndexOf(TempDomain) > -1);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if IsMyDomains then begin
|
|||
|
|
InternalSearch(DNSHeader, Question, QType, LAnswer, True, False, False);
|
|||
|
|
Answer := LAnswer;
|
|||
|
|
|
|||
|
|
if (QType in [TypeCode_A, TypeCode_AAAA]) and (Length(Answer) = 0) then
|
|||
|
|
begin
|
|||
|
|
InternalSearch(DNSHeader, Question, TypeCode_CNAME, LAnswer, True, False, True);
|
|||
|
|
AppendBytes(Answer, LAnswer);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
WildQuestion := Question;
|
|||
|
|
Fetch(WildQuestion, '.');
|
|||
|
|
WildQuestion := '*.' + WildQuestion;
|
|||
|
|
InternalSearch(DNSHeader, WildQuestion, QType, LAnswer, True, False, False, True, Question);
|
|||
|
|
AppendBytes(Answer, LAnswer);
|
|||
|
|
|
|||
|
|
if Length(Answer) > 0 then begin
|
|||
|
|
Result := cRCodeQueryOK;
|
|||
|
|
end else begin
|
|||
|
|
Result := cRCodeQueryNotFound;
|
|||
|
|
end;
|
|||
|
|
end else
|
|||
|
|
begin
|
|||
|
|
InternalSearch(DNSHeader, Question, QType, Answer, True, True, False);
|
|||
|
|
|
|||
|
|
if (QType in [TypeCode_A, TypeCode_AAAA]) and (Length(Answer) = 0) then
|
|||
|
|
begin
|
|||
|
|
InternalSearch(DNSHeader, Question, TypeCode_CNAME, LAnswer, True, True, False);
|
|||
|
|
AppendBytes(Answer, LAnswer);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(Answer) > 0 then begin
|
|||
|
|
Result := cRCodeQueryCacheOK;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
InternalSearch(DNSHeader, Question, TypeCode_Error, Answer, True, True, False);
|
|||
|
|
if BytesToString(Answer) = 'Error' then begin {do not localize}
|
|||
|
|
Result := cRCodeQueryCacheFindError;
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
ExternalSearch(DNSResolver, DNSHeader, OriginalQuestion, Answer);
|
|||
|
|
if Length(Answer) > 0 then begin
|
|||
|
|
Result := cRCodeQueryReturned;
|
|||
|
|
end else begin
|
|||
|
|
Result := cRCodeQueryNotImplement;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.InitComponent;
|
|||
|
|
begin
|
|||
|
|
inherited InitComponent;
|
|||
|
|
|
|||
|
|
FRootDNS_NET := TStringList.Create;
|
|||
|
|
FRootDNS_NET.Add('209.92.33.150'); // nic.net {do not localize}
|
|||
|
|
FRootDNS_NET.Add('209.92.33.130'); // nic.net {do not localize}
|
|||
|
|
FRootDNS_NET.Add('203.37.255.97'); // apnic.net {do not localize}
|
|||
|
|
FRootDNS_NET.Add('202.12.29.131'); // apnic.net {do not localize}
|
|||
|
|
FRootDNS_NET.Add('12.29.20.2'); // nanic.net {do not localize}
|
|||
|
|
FRootDNS_NET.Add('204.145.119.2'); // nanic.net {do not localize}
|
|||
|
|
FRootDNS_NET.Add('140.111.1.2'); // a.twnic.net.tw {do not localize}
|
|||
|
|
|
|||
|
|
FCached_Tree := TIdDNTreeNode.Create(nil);
|
|||
|
|
FCached_Tree.AutoSortChild := True;
|
|||
|
|
FCached_Tree.CLabel := '.';
|
|||
|
|
|
|||
|
|
FHanded_Tree := TIdDNTreeNode.Create(nil);
|
|||
|
|
FHanded_Tree.AutoSortChild := True;
|
|||
|
|
FHanded_Tree.CLabel := '.';
|
|||
|
|
|
|||
|
|
FHanded_DomainList := TStringList.Create;
|
|||
|
|
FZoneMasterFiles := TStringList.Create;
|
|||
|
|
|
|||
|
|
DefaultPort := IdPORT_DOMAIN;
|
|||
|
|
FCS := TIdCriticalSection.Create;
|
|||
|
|
FGlobalCS := TIdCriticalSection.Create;
|
|||
|
|
FBusy := False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdDNS_UDPServer.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FCached_Tree);
|
|||
|
|
FreeAndNil(FHanded_Tree);
|
|||
|
|
FreeAndNil(FRootDNS_NET);
|
|||
|
|
FreeAndNil(FHanded_DomainList);
|
|||
|
|
FreeAndNil(FZoneMasterFiles);
|
|||
|
|
FreeAndNil(FCS);
|
|||
|
|
FreeAndNil(FGlobalCS);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.DoAfterQuery(ABinding: TIdSocketHandle;
|
|||
|
|
ADNSHeader: TDNSHeader; var QueryResult: TIdBytes; var ResultCode : String;
|
|||
|
|
Query : TIdBytes);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnAfterQuery) then begin
|
|||
|
|
FOnAfterQuery(ABinding, ADNSHeader, QueryResult, ResultCode, Query);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.DoBeforeQuery(ABinding: TIdSocketHandle;
|
|||
|
|
ADNSHeader: TDNSHeader; var ADNSQuery: TIdBytes);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnBeforeQuery) then begin
|
|||
|
|
FOnBeforeQuery(ABinding, ADNSHeader, ADNSQuery);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.ExternalSearch(ADNSResolver : TIdDNSResolver;
|
|||
|
|
Header: TDNSHeader; Question: TIdBytes; var Answer: TIdBytes);
|
|||
|
|
var
|
|||
|
|
Server_Index : Integer;
|
|||
|
|
MyDNSResolver : TIdDNSResolver;
|
|||
|
|
begin
|
|||
|
|
if RootDNS_NET.Count = 0 then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
Server_Index := 0;
|
|||
|
|
if ADNSResolver = nil then begin
|
|||
|
|
MyDNSResolver := TIdDNSResolver.Create(Self);
|
|||
|
|
MyDNSResolver.WaitingTime := 5000;
|
|||
|
|
end else begin
|
|||
|
|
MyDNSResolver := ADNSResolver;
|
|||
|
|
end;
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
MyDNSResolver.Host := RootDNS_NET.Strings[Server_Index];
|
|||
|
|
try
|
|||
|
|
MyDNSResolver.InternalQuery := Question;
|
|||
|
|
MyDNSResolver.Resolve('');
|
|||
|
|
Answer := MyDNSResolver.PlainTextResult;
|
|||
|
|
except
|
|||
|
|
// Todo: Create DNS server interal resolver error.
|
|||
|
|
on EIdDnsResolverError do begin
|
|||
|
|
//Empty Event, for user to custom the event handle.
|
|||
|
|
end;
|
|||
|
|
on EIdSocketError do begin
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Inc(Server_Index);
|
|||
|
|
until (Server_Index >= RootDNS_NET.Count) or (Length(Answer) > 0);
|
|||
|
|
finally
|
|||
|
|
if ADNSResolver = nil then begin
|
|||
|
|
FreeAndNil(MyDNSResolver);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_UDPServer.FindHandedNodeByName(QName: String; QType: UInt16): TIdDNTreeNode;
|
|||
|
|
begin
|
|||
|
|
Result := SearchTree(Handed_Tree, QName, QType);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_UDPServer.FindNodeFullName(Root: TIdDNTreeNode; QName: String; QType : UInt16): string;
|
|||
|
|
var
|
|||
|
|
MyNode : TIdDNTreeNode;
|
|||
|
|
begin
|
|||
|
|
MyNode := SearchTree(Root, QName, QType);
|
|||
|
|
if MyNode <> nil then begin
|
|||
|
|
Result := MyNode.FullName;
|
|||
|
|
end else begin
|
|||
|
|
Result := '';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_UDPServer.LoadZoneFromMasterFile(MasterFileName: String): Boolean;
|
|||
|
|
var
|
|||
|
|
FileStrings : TStrings;
|
|||
|
|
begin
|
|||
|
|
{MakeTagList;}
|
|||
|
|
Result := FileExists(MasterFileName);
|
|||
|
|
|
|||
|
|
if Result then begin
|
|||
|
|
FileStrings := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
Todo('LoadZoneFromMasterFile() method of TIdDNS_UDPServer class is not implemented yet'); {do not localize}
|
|||
|
|
// FileStrings.LoadFromFile(MasterFileName);
|
|||
|
|
Result := LoadZoneStrings(FileStrings, MasterFileName, Handed_Tree);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(FileStrings);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
{FreeTagList;}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_UDPServer.LoadZoneStrings(FileStrings: TStrings; Filename : String;
|
|||
|
|
TreeRoot : TIdDNTreeNode): Boolean;
|
|||
|
|
var
|
|||
|
|
TagList : TStrings;
|
|||
|
|
|
|||
|
|
function IsMSDNSFileName(theFileName : String; var DN: string) : Boolean;
|
|||
|
|
var
|
|||
|
|
namepart : TStrings;
|
|||
|
|
Fullname : string;
|
|||
|
|
Count : Integer;
|
|||
|
|
begin
|
|||
|
|
Fullname := theFilename;
|
|||
|
|
repeat
|
|||
|
|
if Pos('\', Fullname) > 0 then begin
|
|||
|
|
Fetch(Fullname, '\');
|
|||
|
|
end;
|
|||
|
|
until Pos('\', Fullname) = 0;
|
|||
|
|
|
|||
|
|
namepart := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
namepart.Add(Fetch(Fullname, '.'));
|
|||
|
|
until Fullname = '';
|
|||
|
|
|
|||
|
|
Result := namepart.Strings[namepart.Count-1] = 'dns'; {do not localize}
|
|||
|
|
if Result then begin
|
|||
|
|
Count := 0;
|
|||
|
|
DN := namepart.Strings[Count];
|
|||
|
|
repeat
|
|||
|
|
Inc(Count);
|
|||
|
|
if Count <= namepart.Count -2 then begin
|
|||
|
|
DN := DN + '.' + namepart.Strings[Count];
|
|||
|
|
end;
|
|||
|
|
until Count >= (namepart.Count-2);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(namepart);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure MakeTagList;
|
|||
|
|
begin
|
|||
|
|
TagList := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
TagList.Add(cAAAA);
|
|||
|
|
TagList.Add(cA);
|
|||
|
|
TagList.Add(cNS);
|
|||
|
|
TagList.Add(cMD);
|
|||
|
|
TagList.Add(cMF);
|
|||
|
|
TagList.Add(cCName);
|
|||
|
|
TagList.Add(cSOA);
|
|||
|
|
TagList.Add(cMB);
|
|||
|
|
TagList.Add(cMG);
|
|||
|
|
TagList.Add(cMR);
|
|||
|
|
TagList.Add(cNULL);
|
|||
|
|
TagList.Add(cWKS);
|
|||
|
|
TagList.Add(cPTR);
|
|||
|
|
TagList.Add(cHINFO);
|
|||
|
|
TagList.Add(cMINFO);
|
|||
|
|
TagList.Add(cMX);
|
|||
|
|
TagList.Add(cTXT);
|
|||
|
|
|
|||
|
|
// The Following Tags are used in master file, but not Resource Record.
|
|||
|
|
TagList.Add(cOrigin);
|
|||
|
|
TagList.Add(cInclude);
|
|||
|
|
//TagList.Add(cAt);
|
|||
|
|
except
|
|||
|
|
FreeAndNil(TagList);
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure FreeTagList;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(TagList);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function ClearDoubleQutoa(Strs : TStrings): Boolean;
|
|||
|
|
var
|
|||
|
|
SSCount : Integer;
|
|||
|
|
Mark, Found : Boolean;
|
|||
|
|
begin
|
|||
|
|
SSCount := 0;
|
|||
|
|
Mark := False;
|
|||
|
|
|
|||
|
|
while SSCount <= (Strs.Count-1) do begin
|
|||
|
|
Found := Pos('"', Strs.Strings[SSCount]) > 0;
|
|||
|
|
while Found do begin
|
|||
|
|
Mark := Mark xor Found;
|
|||
|
|
Strs.Strings[SSCount] := ReplaceSpecString(Strs.Strings[SSCount], '"', '', False);
|
|||
|
|
Found := Pos('"', Strs.Strings[SSCount]) > 0;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if not Mark then begin
|
|||
|
|
Inc(SSCount);
|
|||
|
|
end else begin
|
|||
|
|
Strs.Strings[SSCount] := Strs.Strings[SSCount] + ' ' + Strs.Strings[SSCount + 1];
|
|||
|
|
Strs.Delete(SSCount + 1);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Result := not Mark;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function IsValidMasterFile : Boolean;
|
|||
|
|
var
|
|||
|
|
EachLinePart : TStrings;
|
|||
|
|
CurrentLineNum, TagField, Count : Integer;
|
|||
|
|
LineData, DataBody, {Comment,} FPart, LTag : string;
|
|||
|
|
Denoted, Stop, PassQuota : Boolean;
|
|||
|
|
begin
|
|||
|
|
EachLinePart := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
CurrentLineNum := 0;
|
|||
|
|
Stop := False;
|
|||
|
|
// Check Denoted;
|
|||
|
|
Denoted := false;
|
|||
|
|
|
|||
|
|
if FileStrings.Count > 0 then begin
|
|||
|
|
repeat
|
|||
|
|
LineData := Trim(FileStrings.Strings[CurrentLineNum]);
|
|||
|
|
DataBody := Fetch(LineData, ';');
|
|||
|
|
//Comment := LineData;
|
|||
|
|
PassQuota := Pos('(', DataBody) = 0;
|
|||
|
|
|
|||
|
|
// Split each item into TStrings.
|
|||
|
|
repeat
|
|||
|
|
if not PassQuota then begin
|
|||
|
|
Inc(CurrentLineNum);
|
|||
|
|
LineData := Trim(FileStrings.Strings[CurrentLineNum]);
|
|||
|
|
DataBody := DataBody + ' ' + Fetch(LineData, ';');
|
|||
|
|
PassQuota := Pos(')', DataBody) > 0;
|
|||
|
|
end;
|
|||
|
|
until PassQuota or (CurrentLineNum > (FileStrings.Count-1));
|
|||
|
|
|
|||
|
|
Stop := not PassQuota;
|
|||
|
|
|
|||
|
|
if not Stop then begin
|
|||
|
|
EachLinePart.Clear;
|
|||
|
|
DataBody := ReplaceSpecString(DataBody, '(', '');
|
|||
|
|
DataBody := ReplaceSpecString(DataBody, ')', '');
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
DataBody := Trim(DataBody);
|
|||
|
|
FPart := Fetch(DataBody, #9);
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
FPart := Trim(FPart);
|
|||
|
|
LTag := Fetch(FPart,' ');
|
|||
|
|
|
|||
|
|
if (LTag <> '') and (LTag <> '(') and (LTag <> ')') then begin
|
|||
|
|
EachLinePart.Add(LTag);
|
|||
|
|
end;
|
|||
|
|
until FPart = '';
|
|||
|
|
until DataBody = '';
|
|||
|
|
|
|||
|
|
if not Denoted then begin
|
|||
|
|
if EachLinePart.Count > 1 then begin
|
|||
|
|
Denoted := (EachLinePart.Strings[0] = cOrigin) or (EachLinePart.IndexOf(cSOA) <> -1);
|
|||
|
|
end else begin
|
|||
|
|
Denoted := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Check Syntax;
|
|||
|
|
if not ((EachLinePart.Count > 0) and (EachLinePart.Strings[0] = cOrigin)) then
|
|||
|
|
begin
|
|||
|
|
if not Denoted then begin
|
|||
|
|
if EachLinePart.Count > 0 then begin
|
|||
|
|
Stop := (EachLinePart.Count > 0) and (EachLinePart.IndexOf(cSOA) = -1);
|
|||
|
|
end else begin
|
|||
|
|
Stop := False;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//TagField := -1;
|
|||
|
|
//FieldCount := 0;
|
|||
|
|
|
|||
|
|
// Search Tag Named 'IN';
|
|||
|
|
TagField := EachLinePart.IndexOf('IN'); {do not localize}
|
|||
|
|
|
|||
|
|
if TagField = -1 then begin
|
|||
|
|
Count := 0;
|
|||
|
|
repeat
|
|||
|
|
if EachLinePart.Count > 0 then begin
|
|||
|
|
TagField := TagList.IndexOf(EachLinePart.Strings[Count]);
|
|||
|
|
end;
|
|||
|
|
Inc(Count);
|
|||
|
|
until (Count >= EachLinePart.Count -1) or (TagField <> -1);
|
|||
|
|
|
|||
|
|
if TagField <> -1 then begin
|
|||
|
|
TagField := Count;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
if TagList.IndexOf(EachLinePart.Strings[TagField + 1]) = -1 then begin
|
|||
|
|
TagField := -1;
|
|||
|
|
end else begin
|
|||
|
|
Inc(TagField);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if TagField > -1 then begin
|
|||
|
|
case TagList.IndexOf(EachLinePart.Strings[TagField]) of
|
|||
|
|
// Check ip
|
|||
|
|
TypeCode_A : Stop := not IsValidIP(EachLinePart.Strings[TagField + 1]);
|
|||
|
|
// Check ip v6
|
|||
|
|
0 : Stop := not IsValidIPv6(EachLinePart.Strings[TagField + 1]);
|
|||
|
|
|
|||
|
|
// Check Domain Name
|
|||
|
|
TypeCode_CName, TypeCode_NS, TypeCode_MR,
|
|||
|
|
TypeCode_MD, TypeCode_MB, TypeCode_MG,
|
|||
|
|
TypeCode_MF: Stop := not IsHostName(EachLinePart.Strings[TagField + 1]);
|
|||
|
|
|
|||
|
|
// Can be anything
|
|||
|
|
TypeCode_TXT, TypeCode_NULL: Stop := False;
|
|||
|
|
|
|||
|
|
// Must be FQDN.
|
|||
|
|
TypeCode_PTR: Stop := not IsFQDN(EachLinePart.Strings[TagField + 1]);
|
|||
|
|
|
|||
|
|
// HINFO should has 2 fields : CPU and OS. but TStrings
|
|||
|
|
// is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_HINFO:
|
|||
|
|
begin
|
|||
|
|
Stop := not (ClearDoubleQutoa(EachLinePart) and
|
|||
|
|
((EachLinePart.Count - TagField - 1) = 2));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Check RMailBX and EMailBX but TStrings
|
|||
|
|
// is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_MINFO:
|
|||
|
|
begin
|
|||
|
|
Stop := ((EachLinePart.Count - TagField - 1) <> 2);
|
|||
|
|
if not Stop then begin
|
|||
|
|
Stop := not (IsHostName(EachLinePart.Strings[TagField + 1]) and
|
|||
|
|
IsHostName(EachLinePart.Strings[TagField + 2]));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Check Pref(Numeric) and Exchange. but TStrings
|
|||
|
|
// is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_MX:
|
|||
|
|
begin
|
|||
|
|
Stop := ((EachLinePart.Count - TagField - 1) <> 2);
|
|||
|
|
if not Stop then begin
|
|||
|
|
Stop := not (IsNumeric(EachLinePart.Strings[TagField + 1]) and
|
|||
|
|
IsHostName(EachLinePart.Strings[TagField + 2]));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// TStrings is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_SOA:
|
|||
|
|
begin
|
|||
|
|
Stop := ((EachLinePart.Count - TagField - 1) <> 7);
|
|||
|
|
if not Stop then begin
|
|||
|
|
Stop := not (IsHostName(EachLinePart.Strings[TagField + 1]) and
|
|||
|
|
IsHostName(EachLinePart.Strings[TagField + 2]) and
|
|||
|
|
IsNumeric(EachLinePart.Strings[TagField + 3]) and
|
|||
|
|
IsNumeric(EachLinePart.Strings[TagField + 4]) and
|
|||
|
|
IsNumeric(EachLinePart.Strings[TagField + 5]) and
|
|||
|
|
IsNumeric(EachLinePart.Strings[TagField + 6]) and
|
|||
|
|
IsNumeric(EachLinePart.Strings[TagField + 7])
|
|||
|
|
);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TypeCode_WKS: Stop := ((EachLinePart.Count - TagField) = 1);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
if EachLinePart.Count > 0 then
|
|||
|
|
Stop := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
Inc(CurrentLineNum);
|
|||
|
|
until (CurrentLineNum > (FileStrings.Count-1)) or Stop;
|
|||
|
|
end;
|
|||
|
|
Result := not Stop;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(EachLinePart);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function LoadMasterFile : Boolean;
|
|||
|
|
var
|
|||
|
|
Checks, EachLinePart, DenotedDomain : TStrings;
|
|||
|
|
CurrentLineNum, TagField, Count, LastTTL : Integer;
|
|||
|
|
LineData, DataBody, FPart, LTag, LText,
|
|||
|
|
RName, LastDenotedDomain, LastTag, NewDomain, SingleHostName {CH: , PrevDNTag} : string;
|
|||
|
|
Stop, PassQuota, Found {, canChangPrevDNTag } : Boolean;
|
|||
|
|
LLRR_A : TIdRR_A;
|
|||
|
|
LLRR_AAAA : TIdRR_AAAA;
|
|||
|
|
LLRR_NS : TIdRR_NS;
|
|||
|
|
LLRR_MB : TIdRR_MB;
|
|||
|
|
LLRR_Name : TIdRR_CName;
|
|||
|
|
LLRR_SOA : TIdRR_SOA;
|
|||
|
|
LLRR_MG : TIdRR_MG;
|
|||
|
|
LLRR_MR : TIdRR_MR;
|
|||
|
|
LLRR_PTR : TIdRR_PTR;
|
|||
|
|
LLRR_HINFO : TIdRR_HINFO;
|
|||
|
|
LLRR_MINFO : TIdRR_MINFO;
|
|||
|
|
LLRR_MX : TIdRR_MX;
|
|||
|
|
LLRR_TXT : TIdRR_TXT;
|
|||
|
|
begin
|
|||
|
|
EachLinePart := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
DenotedDomain := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
CurrentLineNum := 0;
|
|||
|
|
LastDenotedDomain := '';
|
|||
|
|
LastTag := '';
|
|||
|
|
NewDomain := '';
|
|||
|
|
// PrevDNTag := '';
|
|||
|
|
Stop := False;
|
|||
|
|
//canChangPrevDNTag := True;
|
|||
|
|
|
|||
|
|
if IsMSDNSFileName(FileName, LastDenotedDomain) then begin
|
|||
|
|
//canChangPrevDNTag := False;
|
|||
|
|
Filename := Uppercase(Filename);
|
|||
|
|
end else begin
|
|||
|
|
LastDenotedDomain := '';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if FileStrings.Count > 0 then begin
|
|||
|
|
repeat
|
|||
|
|
LineData := Trim(FileStrings.Strings[CurrentLineNum]);
|
|||
|
|
DataBody := Fetch(LineData, ';');
|
|||
|
|
// Comment := LineData;
|
|||
|
|
PassQuota := Pos('(', DataBody) = 0;
|
|||
|
|
|
|||
|
|
// Split each item into TStrings.
|
|||
|
|
repeat
|
|||
|
|
if not PassQuota then begin
|
|||
|
|
Inc(CurrentLineNum);
|
|||
|
|
LineData := Trim(FileStrings.Strings[CurrentLineNum]);
|
|||
|
|
DataBody := DataBody + ' ' + Fetch(LineData, ';');
|
|||
|
|
PassQuota := Pos(')', DataBody) > 0;
|
|||
|
|
end;
|
|||
|
|
until PassQuota;
|
|||
|
|
|
|||
|
|
EachLinePart.Clear;
|
|||
|
|
DataBody := ReplaceSpecString(DataBody, '(', '');
|
|||
|
|
DataBody := ReplaceSpecString(DataBody, ')', '');
|
|||
|
|
repeat
|
|||
|
|
DataBody := Trim(DataBody);
|
|||
|
|
FPart := Fetch(DataBody, #9);
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
FPart := Trim(FPart);
|
|||
|
|
if Pos('"', FPart) = 1 then begin
|
|||
|
|
Fetch(FPart, '"');
|
|||
|
|
LText := Fetch(FPart, '"');
|
|||
|
|
EachLinePart.Add(LText);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LTag := Fetch(FPart, ' ');
|
|||
|
|
if (TagList.IndexOf(LTag) = -1) and (LTag <> 'IN') then begin {do not localize}
|
|||
|
|
LTag := LowerCase(LTag);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if (LTag <> '') and (LTag <> '(') and (LTag <> ')') then begin
|
|||
|
|
EachLinePart.Add(LTag);
|
|||
|
|
end;
|
|||
|
|
until FPart = '';
|
|||
|
|
until DataBody = '';
|
|||
|
|
|
|||
|
|
if EachLinePart.Count > 0 then begin
|
|||
|
|
if EachLinePart.Strings[0] = cOrigin then begin
|
|||
|
|
// One Domain is found.
|
|||
|
|
NewDomain := EachLinePart.Strings[1];
|
|||
|
|
if TextEndsWith(NewDomain, '.') then begin
|
|||
|
|
LastDenotedDomain := NewDomain;
|
|||
|
|
NewDomain := '';
|
|||
|
|
end else begin
|
|||
|
|
LastDenotedDomain := NewDomain + '.' + LastDenotedDomain;
|
|||
|
|
NewDomain := '';
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
// Search RR Type Tag;
|
|||
|
|
Count := 0;
|
|||
|
|
TagField := -1;
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
Found := TagList.IndexOf(EachLinePart.Strings[Count]) > -1;
|
|||
|
|
if Found then begin
|
|||
|
|
TagField := Count;
|
|||
|
|
end;
|
|||
|
|
Inc(Count);
|
|||
|
|
until Found or (Count > (EachLinePart.Count-1));
|
|||
|
|
|
|||
|
|
// To initialize LastTTL;
|
|||
|
|
LastTTL := 86400;
|
|||
|
|
if TagField > -1 then begin
|
|||
|
|
case TagField of
|
|||
|
|
1 :
|
|||
|
|
if EachLinePart.Strings[0] <> 'IN' then begin {do not localize}
|
|||
|
|
// canChangPrevDNTag := True;
|
|||
|
|
LastTag := EachLinePart.Strings[0];
|
|||
|
|
if EachLinePart.Strings[TagField] <> 'SOA' then begin {do not localize}
|
|||
|
|
// PrevDNTag := '';
|
|||
|
|
end else begin
|
|||
|
|
LastTTL := IndyStrToInt(EachLinePart.Strings[TagField + 6]);
|
|||
|
|
end;
|
|||
|
|
// end else begin
|
|||
|
|
// canChangPrevDNTag := False;
|
|||
|
|
end;
|
|||
|
|
2 :
|
|||
|
|
if EachLinePart.Strings[1] = 'IN' then begin {do not localize}
|
|||
|
|
LastTag := EachLinePart.Strings[0];
|
|||
|
|
// canChangPrevDNTag := True;
|
|||
|
|
if EachLinePart.Strings[TagField] <> 'SOA' then begin {do not localize}
|
|||
|
|
// PrevDNTag := '';
|
|||
|
|
end else begin
|
|||
|
|
LastTTL := IndyStrToInt(EachLinePart.Strings[TagField + 6]);
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
// canChangPrevDNTag := False;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
// canChangPrevDNTag := False;
|
|||
|
|
LastTTL := 86400;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//if (EachLinePart.Strings[0] = cAt) or (PrevDNTag = 'SOA') then
|
|||
|
|
if EachLinePart.Strings[0] = cAt then begin
|
|||
|
|
SingleHostName := LastDenotedDomain
|
|||
|
|
end else begin
|
|||
|
|
if LastTag = cAt then begin
|
|||
|
|
LastTag := SingleHostName;
|
|||
|
|
end;
|
|||
|
|
if not TextEndsWith(LastTag, '.') then begin
|
|||
|
|
SingleHostName := LastTag + '.' + LastDenotedDomain
|
|||
|
|
end else begin
|
|||
|
|
SingleHostName := LastTag;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
case TagList.IndexOf(EachLinePart.Strings[TagField]) of
|
|||
|
|
// Check ip
|
|||
|
|
TypeCode_A :
|
|||
|
|
begin
|
|||
|
|
LLRR_A := TIdRR_A.Create;
|
|||
|
|
LLRR_A.RRName := SingleHostName;
|
|||
|
|
LLRR_A.Address := EachLinePart.Strings[TagField + 1];
|
|||
|
|
LLRR_A.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_A);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'A';
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Check IPv6 ip address 10/29,2002
|
|||
|
|
0 :
|
|||
|
|
begin
|
|||
|
|
LLRR_AAAA := TIdRR_AAAA.Create;
|
|||
|
|
LLRR_AAAA.RRName := SingleHostName;
|
|||
|
|
LLRR_AAAA.Address := ConvertToValidv6IP(EachLinePart.Strings[TagField + 1]);
|
|||
|
|
LLRR_AAAA.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_AAAA);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'AAAA'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Check Domain Name
|
|||
|
|
TypeCode_CName:
|
|||
|
|
begin
|
|||
|
|
LLRR_Name := TIdRR_CName.Create;
|
|||
|
|
LLRR_Name.RRName := SingleHostName;
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_Name.CName := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_Name.CName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_Name.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_Name);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'CNAME'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TypeCode_NS :
|
|||
|
|
begin
|
|||
|
|
LLRR_NS := TIdRR_NS.Create;
|
|||
|
|
LLRR_NS.RRName := SingleHostName;
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_NS.NSDName := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_NS.NSDName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_NS.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_NS);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'NS'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TypeCode_MR :
|
|||
|
|
begin
|
|||
|
|
LLRR_MR := TIdRR_MR.Create;
|
|||
|
|
LLRR_MR.RRName := SingleHostName;
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_MR.NewName := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_MR.NewName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_MR.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_MR);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'MR'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TypeCode_MD, TypeCode_MB, TypeCode_MF :
|
|||
|
|
begin
|
|||
|
|
LLRR_MB := TIdRR_MB.Create;
|
|||
|
|
LLRR_MB.RRName := SingleHostName;
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_MB.MADName := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_MB.MADName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_MB.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_MB);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'MF'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TypeCode_MG :
|
|||
|
|
begin
|
|||
|
|
LLRR_MG := TIdRR_MG.Create;
|
|||
|
|
LLRR_MG.RRName := SingleHostName;
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_MG.MGMName := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_MG.MGMName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_MG.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_MG);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'MG'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Can be anything
|
|||
|
|
TypeCode_TXT, TypeCode_NULL:
|
|||
|
|
begin
|
|||
|
|
LLRR_TXT := TIdRR_TXT.Create;
|
|||
|
|
LLRR_TXT.RRName := SingleHostName;
|
|||
|
|
LLRR_TXT.TXT := EachLinePart.Strings[TagField + 1];
|
|||
|
|
LLRR_TXT.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_TXT);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'TXT'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Must be FQDN.
|
|||
|
|
TypeCode_PTR:
|
|||
|
|
begin
|
|||
|
|
LLRR_PTR := TIdRR_PTR.Create;
|
|||
|
|
LLRR_PTR.RRName := SingleHostName;
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_PTR.PTRDName := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_PTR.PTRDName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_PTR.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_PTR);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'PTR'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// HINFO should has 2 fields : CPU and OS. but TStrings
|
|||
|
|
// is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_HINFO:
|
|||
|
|
begin
|
|||
|
|
ClearDoubleQutoa(EachLinePart);
|
|||
|
|
|
|||
|
|
LLRR_HINFO := TIdRR_HINFO.Create;
|
|||
|
|
LLRR_HINFO.RRName := SingleHostName;
|
|||
|
|
LLRR_HINFO.CPU := EachLinePart.Strings[TagField + 1];
|
|||
|
|
LLRR_HINFO.OS := EachLinePart.Strings[TagField + 2];
|
|||
|
|
LLRR_HINFO.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_HINFO);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'HINFO'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Check RMailBX and EMailBX but TStrings
|
|||
|
|
// is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_MINFO:
|
|||
|
|
begin
|
|||
|
|
LLRR_MINFO := TIdRR_MINFO.Create;
|
|||
|
|
LLRR_MINFO.RRName := SingleHostName;
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_MINFO.Responsible_Mail := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_MINFO.Responsible_Mail := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 2], '.') then begin
|
|||
|
|
LLRR_MINFO.ErrorHandle_Mail := EachLinePart.Strings[TagField + 2];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_MINFO.ErrorHandle_Mail := EachLinePart.Strings[TagField + 2] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LLRR_MINFO.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_MINFO);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'MINFO'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Check Pref(Numeric) and Exchange. but TStrings
|
|||
|
|
// is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_MX:
|
|||
|
|
begin
|
|||
|
|
LLRR_MX := TIdRR_MX.Create;
|
|||
|
|
LLRR_MX.RRName := SingleHostName;
|
|||
|
|
LLRR_MX.Preference := EachLinePart.Strings[TagField + 1];
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 2], '.') then begin
|
|||
|
|
LLRR_MX.Exchange := EachLinePart.Strings[TagField + 2];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_MX.Exchange := EachLinePart.Strings[TagField + 2] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_MX.TTL := LastTTL;
|
|||
|
|
|
|||
|
|
UpdateTree(TreeRoot, LLRR_MX);
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'MX'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// TStrings is 0 base, so that we have to minus one
|
|||
|
|
TypeCode_SOA:
|
|||
|
|
begin
|
|||
|
|
LLRR_SOA := TIdRR_SOA.Create;
|
|||
|
|
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 1], '.') then begin
|
|||
|
|
LLRR_SOA.MName := EachLinePart.Strings[TagField + 1];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_SOA.MName := EachLinePart.Strings[TagField + 1] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
//LLRR_SOA.RRName:= LLRR_SOA.MName;
|
|||
|
|
if (SingleHostName = '') and (LastDenotedDomain = '') then begin
|
|||
|
|
{$IFDEF STRING_IS_UNICODE}
|
|||
|
|
LastDenotedDomain := String(LLRR_SOA.MName); // explicit convert to Unicode
|
|||
|
|
{$ELSE}
|
|||
|
|
LastDenotedDomain := LLRR_SOA.MName;
|
|||
|
|
{$ENDIF}
|
|||
|
|
Fetch(LastDenotedDomain, '.');
|
|||
|
|
SingleHostName := LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
LLRR_SOA.RRName := SingleHostName;
|
|||
|
|
|
|||
|
|
// Update the Handed List
|
|||
|
|
{
|
|||
|
|
if Handed_DomainList.IndexOf(LLRR_SOA.MName) = -1 then begin
|
|||
|
|
Handed_DomainList.Add(LLRR_SOA.MName);
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
if Handed_DomainList.IndexOf(LLRR_SOA.RRName) = -1 then begin
|
|||
|
|
Handed_DomainList.Add(LLRR_SOA.RRName);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
if DenotedDomain.IndexOf(LLRR_SOA.MName) = -1 then begin
|
|||
|
|
DenotedDomain.Add(LLRR_SOA.MName);
|
|||
|
|
end;
|
|||
|
|
LastDenotedDomain := LLRR_SOA.MName;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if DenotedDomain.IndexOf(LLRR_SOA.RRName) = -1 then begin
|
|||
|
|
DenotedDomain.Add(LLRR_SOA.RRName);
|
|||
|
|
end;
|
|||
|
|
//LastDenotedDomain := LLRR_SOA.RRName;
|
|||
|
|
|
|||
|
|
if TextEndsWith(EachLinePart.Strings[TagField + 2], '.') then begin
|
|||
|
|
LLRR_SOA.RName := EachLinePart.Strings[TagField + 2];
|
|||
|
|
end else begin
|
|||
|
|
LLRR_SOA.RName := EachLinePart.Strings[TagField + 2] + '.' + LastDenotedDomain;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Checks := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
{$IFDEF STRING_IS_UNICODE}
|
|||
|
|
RName := String(LLRR_SOA.RName); // explicit convert to Unicode
|
|||
|
|
{$ELSE}
|
|||
|
|
RName := LLRR_SOA.RName;
|
|||
|
|
{$ENDIF}
|
|||
|
|
|
|||
|
|
while RName <> '' do begin
|
|||
|
|
Checks.Add(Fetch(RName, '.'));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
RName := '';
|
|||
|
|
For Count := 0 to Checks.Count -1 do begin
|
|||
|
|
if Checks.Strings[Count] <> '' then begin
|
|||
|
|
RName := RName + Checks.Strings[Count] + '.';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LLRR_SOA.RName := RName;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(Checks);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LLRR_SOA.Serial := EachLinePart.Strings[TagField + 3];
|
|||
|
|
LLRR_SOA.Refresh := EachLinePart.Strings[TagField + 4];
|
|||
|
|
LLRR_SOA.Retry := EachLinePart.Strings[TagField + 5];
|
|||
|
|
LLRR_SOA.Expire := EachLinePart.Strings[TagField + 6];
|
|||
|
|
LLRR_SOA.Minimum := EachLinePart.Strings[TagField + 7];
|
|||
|
|
LastTTL := IndyStrToInt(LLRR_SOA.Expire);
|
|||
|
|
LLRR_SOA.TTL := LastTTL;
|
|||
|
|
UpdateTree(TreeRoot, LLRR_SOA);
|
|||
|
|
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'SOA'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TypeCode_WKS:
|
|||
|
|
begin
|
|||
|
|
// if canChangPrevDNTag then begin
|
|||
|
|
// PrevDNTag := 'WKS'; {do not localize}
|
|||
|
|
// end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end; // if EachLinePart.Count == 0 => Only Comment
|
|||
|
|
end;
|
|||
|
|
Inc(CurrentLineNum);
|
|||
|
|
until (CurrentLineNum > (FileStrings.Count -1));
|
|||
|
|
end;
|
|||
|
|
Result := not Stop;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(DenotedDomain);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(EachLinePart);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
MakeTagList;
|
|||
|
|
try
|
|||
|
|
Result := IsValidMasterFile;
|
|||
|
|
// IsValidMasterFile is used in local, so I design with not
|
|||
|
|
// any parameter.
|
|||
|
|
if Result then begin
|
|||
|
|
Result := LoadMasterFile;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeTagList;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.SaveToCache(ResourceRecord: TIdBytes; QueryName : string; OriginalQType : UInt16);
|
|||
|
|
var
|
|||
|
|
TempResolver : TIdDNSResolver;
|
|||
|
|
Count : Integer;
|
|||
|
|
begin
|
|||
|
|
TempResolver := TIdDNSResolver.Create(nil);
|
|||
|
|
try
|
|||
|
|
// RLebeau: FillResultWithOutCheckId() is deprecated, but not using FillResult()
|
|||
|
|
// here yet because it validates the DNSHeader.RCode, and I do not know if that
|
|||
|
|
// is needed here. I don't want to break this logic...
|
|||
|
|
TempResolver.FillResultWithOutCheckId(ResourceRecord);
|
|||
|
|
if TempResolver.DNSHeader.ANCount > 0 then begin
|
|||
|
|
for Count := 0 to TempResolver.QueryResult.Count - 1 do begin
|
|||
|
|
UpdateTree(Cached_Tree, TempResolver.QueryResult.Items[Count]);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(TempResolver);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_UDPServer.SearchTree(Root: TIdDNTreeNode; QName: String; QType : UInt16): TIdDNTreeNode;
|
|||
|
|
var
|
|||
|
|
RRIndex : integer;
|
|||
|
|
NodeCursor : TIdDNTreeNode;
|
|||
|
|
NameLabels : TStrings;
|
|||
|
|
OneNode, FullName : string;
|
|||
|
|
Found : Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := nil;
|
|||
|
|
NameLabels := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
FullName := QName;
|
|||
|
|
NodeCursor := Root;
|
|||
|
|
Found := False;
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
OneNode := Fetch(FullName, '.');
|
|||
|
|
if OneNode <> '' then begin
|
|||
|
|
NameLabels.Add(OneNode);
|
|||
|
|
end;
|
|||
|
|
until FullName = '';
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
if QType <> TypeCode_SOA then begin
|
|||
|
|
RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
|
|||
|
|
if RRIndex <> -1 then begin
|
|||
|
|
NameLabels.Delete(NameLabels.Count - 1);
|
|||
|
|
NodeCursor := NodeCursor.Children[RRIndex];
|
|||
|
|
|
|||
|
|
if NameLabels.Count = 1 then begin
|
|||
|
|
Found := NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1;
|
|||
|
|
end else begin
|
|||
|
|
Found := NameLabels.Count = 0;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
if NameLabels.Count = 1 then begin
|
|||
|
|
Found := NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1;
|
|||
|
|
if not Found then begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
|
|||
|
|
if RRIndex <> -1 then begin
|
|||
|
|
NameLabels.Delete(NameLabels.Count - 1);
|
|||
|
|
NodeCursor := NodeCursor.Children[RRIndex];
|
|||
|
|
|
|||
|
|
if NameLabels.Count = 1 then begin
|
|||
|
|
Found := NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1;
|
|||
|
|
end else begin
|
|||
|
|
Found := NameLabels.Count = 0;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
if NameLabels.Count = 1 then begin
|
|||
|
|
Found := NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1;
|
|||
|
|
if not Found then begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
until (NameLabels.Count = 0) or Found;
|
|||
|
|
|
|||
|
|
if Found then begin
|
|||
|
|
Result := NodeCursor;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(NameLabels);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.SetHanded_DomainList(const Value: TStrings);
|
|||
|
|
begin
|
|||
|
|
FHanded_DomainList.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.SetRootDNS_NET(const Value: TStrings);
|
|||
|
|
begin
|
|||
|
|
FRootDNS_NET.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.SetZoneMasterFiles(const Value: TStrings);
|
|||
|
|
begin
|
|||
|
|
FZoneMasterFiles.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.UpdateTree(TreeRoot: TIdDNTreeNode; RR: TResultRecord);
|
|||
|
|
var
|
|||
|
|
NameNode : TStrings;
|
|||
|
|
RRName, APart : String;
|
|||
|
|
Count, NodeIndex : Integer;
|
|||
|
|
NodeCursor : TIdDNTreeNode;
|
|||
|
|
LRR_A : TIdRR_A;
|
|||
|
|
LRR_AAAA : TIdRR_AAAA;
|
|||
|
|
LRR_NS : TIdRR_NS;
|
|||
|
|
LRR_MB : TIdRR_MB;
|
|||
|
|
LRR_Name : TIdRR_CName;
|
|||
|
|
LRR_SOA : TIdRR_SOA;
|
|||
|
|
LRR_MG : TIdRR_MG;
|
|||
|
|
LRR_MR : TIdRR_MR;
|
|||
|
|
LRR_PTR : TIdRR_PTR;
|
|||
|
|
LRR_HINFO : TIdRR_HINFO;
|
|||
|
|
LRR_MINFO : TIdRR_MINFO;
|
|||
|
|
LRR_MX : TIdRR_MX;
|
|||
|
|
LRR_TXT : TIdRR_TXT;
|
|||
|
|
begin
|
|||
|
|
RRName := RR.Name;
|
|||
|
|
|
|||
|
|
NameNode := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
APart := Fetch(RRName, '.');
|
|||
|
|
if APart <> '' then begin
|
|||
|
|
NameNode.Add(APart);
|
|||
|
|
end;
|
|||
|
|
until RRName = '';
|
|||
|
|
|
|||
|
|
NodeCursor := TreeRoot;
|
|||
|
|
RRName := RR.Name;
|
|||
|
|
if not TextEndsWith(RRName, '.') then begin
|
|||
|
|
RRName := RRName + '.';
|
|||
|
|
end;
|
|||
|
|
if (RR.RecType <> qtSOA) and (Handed_DomainList.IndexOf(LowerCase(RRName)) = -1) and (RR.RecType <> qtNS) then begin
|
|||
|
|
for Count := NameNode.Count-1 downto 1 do begin
|
|||
|
|
NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
|
|||
|
|
if NodeIndex = -1 then begin
|
|||
|
|
NodeCursor := NodeCursor.AddChild;
|
|||
|
|
NodeCursor.AutoSortChild := True;
|
|||
|
|
NodeCursor.CLabel := NameNode.Strings[Count];
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor := NodeCursor.Children[NodeIndex];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
RRName := NameNode.Strings[0];
|
|||
|
|
end else begin
|
|||
|
|
for Count := NameNode.Count-1 downto 0 do begin
|
|||
|
|
NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
|
|||
|
|
RRName := NameNode.Strings[Count];
|
|||
|
|
if NodeIndex = -1 then begin
|
|||
|
|
NodeCursor := NodeCursor.AddChild;
|
|||
|
|
//NodeCursor.CLabel := RRName;
|
|||
|
|
NodeCursor.AutoSortChild := True;
|
|||
|
|
NodeCursor.CLabel := RRName;
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor := NodeCursor.Children[NodeIndex];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
RRName := RR.Name;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
NodeCursor.RRs.ItemNames.Add(RRName);
|
|||
|
|
|
|||
|
|
case RR.RecType of
|
|||
|
|
qtA :
|
|||
|
|
begin
|
|||
|
|
LRR_A := TIdRR_A.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_A);
|
|||
|
|
except
|
|||
|
|
LRR_A.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_A.RRName := RRName;
|
|||
|
|
LRR_A.Address := TARecord(RR).IPAddress;
|
|||
|
|
LRR_A.TTL := TARecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_A.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_A.RRName := LRR_A.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtAAAA :
|
|||
|
|
begin
|
|||
|
|
LRR_AAAA := TIdRR_AAAA.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_AAAA);
|
|||
|
|
except
|
|||
|
|
LRR_AAAA.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_AAAA.RRName := RRName;
|
|||
|
|
LRR_AAAA.Address := TAAAARecord(RR).Address;
|
|||
|
|
LRR_AAAA.TTL := TAAAARecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_AAAA.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_AAAA.RRName := LRR_AAAA.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtNS:
|
|||
|
|
begin
|
|||
|
|
LRR_NS := TIdRR_NS.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_NS);
|
|||
|
|
except
|
|||
|
|
LRR_NS.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_NS.RRName := RRName;
|
|||
|
|
LRR_NS.NSDName := TNSRecord(RR).HostName;
|
|||
|
|
LRR_NS.TTL := TNSRecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_NS.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_NS.RRName := LRR_NS.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtMD, qtMF, qtMB:
|
|||
|
|
begin
|
|||
|
|
LRR_MB := TIdRR_MB.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_MB);
|
|||
|
|
except
|
|||
|
|
LRR_MB.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_MB.RRName := RRName;
|
|||
|
|
LRR_MB.MADName := TNAMERecord(RR).HostName;
|
|||
|
|
LRR_MB.TTL := TNAMERecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_MB.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_MB.RRName := LRR_MB.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtName:
|
|||
|
|
begin
|
|||
|
|
LRR_Name := TIdRR_CName.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_Name);
|
|||
|
|
except
|
|||
|
|
LRR_Name.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_Name.RRName := RRName;
|
|||
|
|
LRR_Name.CName := TNAMERecord(RR).HostName;
|
|||
|
|
LRR_Name.TTL:= TNAMERecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_Name.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_Name.RRName := LRR_Name.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtSOA:
|
|||
|
|
begin
|
|||
|
|
LRR_SOA := TIdRR_SOA.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_SOA);
|
|||
|
|
except
|
|||
|
|
LRR_SOA.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_SOA.RRName := RRName;
|
|||
|
|
|
|||
|
|
LRR_SOA.MName := TSOARecord(RR).Primary;
|
|||
|
|
LRR_SOA.RName := TSOARecord(RR).ResponsiblePerson;
|
|||
|
|
LRR_SOA.Serial := IntToStr(TSOARecord(RR).Serial);
|
|||
|
|
LRR_SOA.Minimum := IntToStr(TSOARecord(RR).MinimumTTL);
|
|||
|
|
LRR_SOA.Refresh := IntToStr(TSOARecord(RR).Refresh);
|
|||
|
|
LRR_SOA.Retry := IntToStr(TSOARecord(RR).Retry);
|
|||
|
|
LRR_SOA.Expire := IntToStr(TSOARecord(RR).Expire);
|
|||
|
|
LRR_SOA.TTL:= TSOARecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_SOA.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_SOA.RRName := LRR_SOA.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end
|
|||
|
|
else if not TextEndsWith(LRR_SOA.RRName, '.') then begin
|
|||
|
|
LRR_SOA.RRName := LRR_SOA.RRName + '.';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtMG :
|
|||
|
|
begin
|
|||
|
|
LRR_MG := TIdRR_MG.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_MG);
|
|||
|
|
except
|
|||
|
|
LRR_MG.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_MG.RRName := RRName;
|
|||
|
|
LRR_MG.MGMName := TNAMERecord(RR).HostName;
|
|||
|
|
LRR_MG.TTL := TNAMERecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_MG.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_MG.RRName := LRR_MG.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtMR :
|
|||
|
|
begin
|
|||
|
|
LRR_MR := TIdRR_MR.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_MR);
|
|||
|
|
except
|
|||
|
|
LRR_MR.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_MR.RRName := RRName;
|
|||
|
|
LRR_MR.NewName := TNAMERecord(RR).HostName;
|
|||
|
|
LRR_MR.TTL := TNAMERecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_MR.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_MR.RRName := LRR_MR.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtWKS:
|
|||
|
|
begin
|
|||
|
|
end;
|
|||
|
|
qtPTR:
|
|||
|
|
begin
|
|||
|
|
LRR_PTR := TIdRR_PTR.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_PTR);
|
|||
|
|
except
|
|||
|
|
LRR_PTR.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_PTR.RRName := RRName;
|
|||
|
|
LRR_PTR.PTRDName := TPTRRecord(RR).HostName;
|
|||
|
|
LRR_PTR.TTL := TPTRRecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_PTR.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_PTR.RRName := LRR_PTR.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtHINFO:
|
|||
|
|
begin
|
|||
|
|
LRR_HINFO := TIdRR_HINFO.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_HINFO);
|
|||
|
|
except
|
|||
|
|
LRR_HINFO.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_HINFO.RRName := RRName;
|
|||
|
|
LRR_HINFO.CPU := THINFORecord(RR).CPU;
|
|||
|
|
LRR_HINFO.OS := THINFORecord(RR).OS;
|
|||
|
|
LRR_HINFO.TTL := THINFORecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_HINFO.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_HINFO.RRName := LRR_HINFO.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtMINFO:
|
|||
|
|
begin
|
|||
|
|
LRR_MINFO := TIdRR_MINFO.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_MINFO);
|
|||
|
|
except
|
|||
|
|
LRR_MINFO.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_MINFO.RRName := RRName;
|
|||
|
|
LRR_MINFO.Responsible_Mail := TMINFORecord(RR).ResponsiblePersonMailbox;
|
|||
|
|
LRR_MINFO.ErrorHandle_Mail := TMINFORecord(RR).ErrorMailbox;
|
|||
|
|
LRR_MINFO.TTL := TMINFORecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_MINFO.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_MINFO.RRName := LRR_MINFO.RRName + '.' + NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtMX:
|
|||
|
|
begin
|
|||
|
|
LRR_MX := TIdRR_MX.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_MX);
|
|||
|
|
except
|
|||
|
|
LRR_MX.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_MX.RRName := RRName;
|
|||
|
|
LRR_MX.Exchange := TMXRecord(RR).ExchangeServer;
|
|||
|
|
LRR_MX.Preference := IntToStr(TMXRecord(RR).Preference);
|
|||
|
|
LRR_MX.TTL := TMXRecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_MX.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_MX.RRName := LRR_MX.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
qtTXT, qtNULL:
|
|||
|
|
begin
|
|||
|
|
LRR_TXT := TIdRR_TXT.Create;
|
|||
|
|
try
|
|||
|
|
NodeCursor.RRs.Add(LRR_TXT);
|
|||
|
|
except
|
|||
|
|
LRR_TXT.Free;
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
LRR_TXT.RRName := RRName;
|
|||
|
|
LRR_TXT.TXT := TTextRecord(RR).Text.Text;
|
|||
|
|
LRR_TXT.TTL := TTextRecord(RR).TTL;
|
|||
|
|
|
|||
|
|
if LRR_TXT.ifAddFullName(NodeCursor.FullName) then begin
|
|||
|
|
LRR_TXT.RRName := LRR_TXT.RRName + '.'+ NodeCursor.FullName;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(NameNode);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.UpdateTree(TreeRoot: TIdDNTreeNode; RR: TIdTextModeResourceRecord);
|
|||
|
|
var
|
|||
|
|
NameNode : TStrings;
|
|||
|
|
RRName, APart : String;
|
|||
|
|
Count, NodeIndex, RRIndex : Integer;
|
|||
|
|
NodeCursor : TIdDNTreeNode;
|
|||
|
|
LRR_AAAA : TIdRR_AAAA;
|
|||
|
|
LRR_A : TIdRR_A;
|
|||
|
|
LRR_NS : TIdRR_NS;
|
|||
|
|
LRR_MB : TIdRR_MB;
|
|||
|
|
LRR_Name : TIdRR_CName;
|
|||
|
|
LRR_SOA : TIdRR_SOA;
|
|||
|
|
LRR_MG : TIdRR_MG;
|
|||
|
|
LRR_MR : TIdRR_MR;
|
|||
|
|
LRR_PTR : TIdRR_PTR;
|
|||
|
|
LRR_HINFO : TIdRR_HINFO;
|
|||
|
|
LRR_MINFO : TIdRR_MINFO;
|
|||
|
|
LRR_MX : TIdRR_MX;
|
|||
|
|
LRR_TXT : TIdRR_TXT;
|
|||
|
|
LRR_Error : TIdRR_Error;
|
|||
|
|
begin
|
|||
|
|
RRName := RR.RRName;
|
|||
|
|
|
|||
|
|
NameNode := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
APart := Fetch(RRName, '.');
|
|||
|
|
if APart <> '' then begin
|
|||
|
|
NameNode.Add(APart);
|
|||
|
|
end;
|
|||
|
|
until RRName = '';
|
|||
|
|
|
|||
|
|
NodeCursor := TreeRoot;
|
|||
|
|
RRName := RR.RRName;
|
|||
|
|
if not TextEndsWith(RRName, '.') then begin
|
|||
|
|
RR.RRName := RR.RRName + '.';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// VC: in2002-02-24-1715, it just denoted TIdRR_A and TIdRR_PTR,
|
|||
|
|
// but that make search a domain name RR becoming complex,
|
|||
|
|
// therefor I replace it with all RRs but not TIdRR_SOA
|
|||
|
|
// SOA should own independent node.
|
|||
|
|
if (not (RR is TIdRR_SOA)) and (Handed_DomainList.IndexOf(LowerCase(RR.RRName)) = -1) then begin
|
|||
|
|
for Count := NameNode.Count - 1 downto 1 do begin
|
|||
|
|
NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
|
|||
|
|
if NodeIndex = -1 then begin
|
|||
|
|
NodeCursor := NodeCursor.AddChild;
|
|||
|
|
NodeCursor.AutoSortChild := True;
|
|||
|
|
NodeCursor.CLabel := NameNode.Strings[Count];
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor := NodeCursor.Children[NodeIndex];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
RRName := NameNode.Strings[0];
|
|||
|
|
end else begin
|
|||
|
|
for Count := NameNode.Count -1 downto 0 do begin
|
|||
|
|
NodeIndex := NodeCursor.ChildIndex.IndexOf(NameNode.Strings[Count]);
|
|||
|
|
RRName := NameNode.Strings[Count];
|
|||
|
|
if NodeIndex = -1 then begin
|
|||
|
|
NodeCursor := NodeCursor.AddChild;
|
|||
|
|
NodeCursor.AutoSortChild := True;
|
|||
|
|
NodeCursor.CLabel := RRName;
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor := NodeCursor.Children[NodeIndex];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
RRName := RR.RRName;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
RRIndex := NodeCursor.RRs.ItemNames.IndexOf(RRName);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.ItemNames.Add(RRName);
|
|||
|
|
end else begin
|
|||
|
|
repeat
|
|||
|
|
Inc(RRIndex);
|
|||
|
|
if RRIndex > NodeCursor.RRs.ItemNames.Count -1 then begin
|
|||
|
|
RRIndex := -1;
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
if NodeCursor.RRs.ItemNames.Strings[RRIndex] <> RRName then begin
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
until RRIndex > (NodeCursor.RRs.ItemNames.Count-1);
|
|||
|
|
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.ItemNames.Add(RRName);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.ItemNames.Insert(RRIndex, RRName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
case RR.TypeCode of
|
|||
|
|
TypeCode_Error :
|
|||
|
|
begin
|
|||
|
|
LRR_Error := TIdRR_Error(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_Error);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_Error);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_A :
|
|||
|
|
begin
|
|||
|
|
LRR_A := TIdRR_A(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_A);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_A);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_AAAA :
|
|||
|
|
begin
|
|||
|
|
LRR_AAAA := TIdRR_AAAA(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_AAAA);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_AAAA);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_NS:
|
|||
|
|
begin
|
|||
|
|
LRR_NS := TIdRR_NS(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_NS);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_NS);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MF:
|
|||
|
|
begin
|
|||
|
|
LRR_MB := TIdRR_MB(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_MB);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_MB);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_CName:
|
|||
|
|
begin
|
|||
|
|
LRR_Name := TIdRR_CName(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_Name);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_Name);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_SOA:
|
|||
|
|
begin
|
|||
|
|
LRR_SOA := TIdRR_SOA(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_SOA);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_SOA);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MG :
|
|||
|
|
begin
|
|||
|
|
LRR_MG := TIdRR_MG(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_MG);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_MG);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MR :
|
|||
|
|
begin
|
|||
|
|
LRR_MR := TIdRR_MR(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_MR);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_MR);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_WKS:
|
|||
|
|
begin
|
|||
|
|
end;
|
|||
|
|
TypeCode_PTR:
|
|||
|
|
begin
|
|||
|
|
LRR_PTR := TIdRR_PTR(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_PTR);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_PTR);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_HINFO:
|
|||
|
|
begin
|
|||
|
|
LRR_HINFO := TIdRR_HINFO(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_HINFO);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_HINFO);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MINFO:
|
|||
|
|
begin
|
|||
|
|
LRR_MINFO := TIdRR_MINFO(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_MINFO);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_MINFO);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MX:
|
|||
|
|
begin
|
|||
|
|
LRR_MX := TIdRR_MX(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_MX);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_MX);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_TXT, TypeCode_NULL:
|
|||
|
|
begin
|
|||
|
|
LRR_TXT := TIdRR_TXT(RR);
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
NodeCursor.RRs.Add(LRR_TXT);
|
|||
|
|
end else begin
|
|||
|
|
NodeCursor.RRs.Insert(RRIndex, LRR_TXT);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(NameNode);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.DoAfterSendBack(ABinding: TIdSocketHandle;
|
|||
|
|
ADNSHeader: TDNSHeader; var QueryResult: TIdBytes; var ResultCode: String;
|
|||
|
|
Query : TIdBytes);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnAfterSendBack) then begin
|
|||
|
|
FOnAfterSendBack(ABinding, ADNSHeader, QueryResult, ResultCode, Query);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_UDPServer.AXFR(Header : TDNSHeader; Question: string; var Answer: TIdBytes): string;
|
|||
|
|
var
|
|||
|
|
TargetNode : TIdDNTreeNode;
|
|||
|
|
IsMyDomains : Boolean;
|
|||
|
|
RRcount : Integer;
|
|||
|
|
Temp: TIdBytes;
|
|||
|
|
begin
|
|||
|
|
Question := LowerCase(Question);
|
|||
|
|
|
|||
|
|
IsMyDomains := Handed_DomainList.IndexOf(Question) > -1;
|
|||
|
|
if not IsMyDomains then begin
|
|||
|
|
Fetch(Question, '.');
|
|||
|
|
IsMyDomains := Handed_DomainList.IndexOf(Question) > -1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Is my domain, go for searching the node.
|
|||
|
|
TargetNode := nil;
|
|||
|
|
SetLength(Answer, 0);
|
|||
|
|
Header.ANCount := 0;
|
|||
|
|
if IsMyDomains then begin
|
|||
|
|
TargetNode := SearchTree(Handed_Tree, Question, TypeCode_SOA);
|
|||
|
|
end;
|
|||
|
|
if IsMyDomains and (TargetNode <> nil) then begin
|
|||
|
|
// combine the AXFR Data(So many)
|
|||
|
|
|
|||
|
|
RRCount := 0;
|
|||
|
|
Answer := TargetNode.DumpAllBinaryData(RRCount);
|
|||
|
|
Header.ANCount := RRCount;
|
|||
|
|
|
|||
|
|
Header.QR := iQr_Answer;
|
|||
|
|
Header.AA := iAA_Authoritative;
|
|||
|
|
Header.RCode := iRCodeNoError;
|
|||
|
|
Header.QDCount := 0;
|
|||
|
|
Header.ARCount := 0;
|
|||
|
|
Header.TC := 0;
|
|||
|
|
Temp := Header.GenerateBinaryHeader;
|
|||
|
|
AppendBytes(Temp, Answer);
|
|||
|
|
Answer := Temp;
|
|||
|
|
|
|||
|
|
Result := cRCodeQueryOK;
|
|||
|
|
end else begin
|
|||
|
|
Header.QR := iQr_Answer;
|
|||
|
|
Header.AA := iAA_Authoritative;
|
|||
|
|
Header.RCode := iRCodeNameError;
|
|||
|
|
Header.QDCount := 0;
|
|||
|
|
Header.ARCount := 0;
|
|||
|
|
Header.TC := 0;
|
|||
|
|
|
|||
|
|
Answer := Header.GenerateBinaryHeader;
|
|||
|
|
Result := cRCodeQueryNotFound;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.InternalSearch(Header: TDNSHeader; QName: string;
|
|||
|
|
QType : UInt16; var Answer: TIdBytes; IfMainQuestion : Boolean;
|
|||
|
|
IsSearchCache : Boolean = False; IsAdditional : Boolean = False;
|
|||
|
|
IsWildCard : Boolean = False; WildCardOrgName : string = '');
|
|||
|
|
var
|
|||
|
|
MoreAddrSearch : TStrings;
|
|||
|
|
TargetNode : TIdDNTreeNode;
|
|||
|
|
Server_Index, RRIndex, Count : Integer;
|
|||
|
|
LocalAnswer, TempBytes, TempAnswer: TIdBytes;
|
|||
|
|
temp_QName, temp: string;
|
|||
|
|
AResult: TIdBytes;
|
|||
|
|
Stop, Extra, IsMyDomains, ifAdditional : Boolean;
|
|||
|
|
LDNSResolver : TIdDNSResolver;
|
|||
|
|
|
|||
|
|
procedure CheckMoreAddrSearch(const AStr: String);
|
|||
|
|
begin
|
|||
|
|
if (not IsValidIP(AStr)) and IsHostName(AStr) then begin
|
|||
|
|
MoreAddrSearch.Add(AStr);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
SetLength(Answer, 0);
|
|||
|
|
SetLength(Aresult, 0);
|
|||
|
|
// Search the Handed Tree first.
|
|||
|
|
MoreAddrSearch := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
Extra := False;
|
|||
|
|
//Pushed := False;
|
|||
|
|
|
|||
|
|
if not IsSearchCache then begin
|
|||
|
|
TargetNode := SearchTree(Handed_Tree, QName, QType);
|
|||
|
|
|
|||
|
|
if TargetNode <> nil then begin //Assemble the Answer.
|
|||
|
|
RRIndex := TargetNode.RRs.ItemNames.IndexOf(LowerCase(QName));
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
{ below are added again by Dennies Chang in 2004/7/15
|
|||
|
|
{ According RFC 1035, a full domain name must be tailed by a '.',
|
|||
|
|
{ but in normal behavior, user will not input '.' in last
|
|||
|
|
{ position of the full name. So we have to compare both of the
|
|||
|
|
{ cases. }
|
|||
|
|
if TextEndsWith(QName, '.') then begin
|
|||
|
|
QName := Copy(QName, 1, Length(QName)-1);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
RRIndex := TargetNode.RRs.ItemNames.IndexOf(LowerCase(QName));
|
|||
|
|
{ above are added again by Dennies Chang in 2004/7/15}
|
|||
|
|
|
|||
|
|
if RRIndex = -1 then begin
|
|||
|
|
QName := Fetch(QName, '.');
|
|||
|
|
RRIndex := TargetNode.RRs.ItemNames.IndexOf(LowerCase(QName));
|
|||
|
|
end;
|
|||
|
|
{ marked by Dennies Chang in 2004/7/15
|
|||
|
|
QName:= Fetch(QName, '.');
|
|||
|
|
RRIndex := TargetNode.RRs.ItemNames.IndexOf(IndyLowerCase(QName));
|
|||
|
|
}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
temp_QName := QName;
|
|||
|
|
SetLength(LocalAnswer, 0);
|
|||
|
|
|
|||
|
|
if RRIndex <> -1 then begin
|
|||
|
|
case QType of
|
|||
|
|
TypeCode_A:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_A then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_AAAA:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_AAAA then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_NS:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_NS then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MD:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MF:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_CName:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_CName then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_CName).CName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_SOA:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_SOA then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName);
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MB:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MG:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MG then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MR:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MR then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_NULL:
|
|||
|
|
begin
|
|||
|
|
{
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_NULL then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
end;
|
|||
|
|
TypeCode_WKS:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_WKS then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_PTR:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_PTR then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_HINFO:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_HINFO then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MINFO:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MINFO then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MX:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MX then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MX).Exchange);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_TXT:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_TXT then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_STAR:
|
|||
|
|
begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if IsWildCard and (Length(LocalAnswer) > 0) then begin
|
|||
|
|
{
|
|||
|
|
temp := DomainNameToDNSStr(QName+'.'+TargetNode.FullName);
|
|||
|
|
Fetch(LocalAnswer, temp);
|
|||
|
|
}
|
|||
|
|
TempBytes := DomainNameToDNSStr(TargetNode.FullName);
|
|||
|
|
FetchBytes(LocalAnswer, TempBytes);
|
|||
|
|
TempBytes := DomainNameToDNSStr(WildCardOrgName);
|
|||
|
|
AppendBytes(TempBytes, LocalAnswer);
|
|||
|
|
LocalAnswer := TempBytes;
|
|||
|
|
//LocalAnswer := DomainNameToDNSStr(WildCardOrgName) + LocalAnswer;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) > 0 then begin
|
|||
|
|
AppendBytes(Answer, LocalAnswer);
|
|||
|
|
if ((not Extra) and (not IsAdditional)) or (QType = TypeCode_AAAA) then begin
|
|||
|
|
if (TargetNode.RRs.Items[RRIndex] is TIdRR_NS) then begin
|
|||
|
|
if IfMainQuestion then begin
|
|||
|
|
Header.ANCount := Header.ANCount + 1;
|
|||
|
|
end else begin
|
|||
|
|
Header.NSCount := Header.NSCount + 1;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if IfMainQuestion then begin
|
|||
|
|
Header.ANCount := Header.ANCount + 1;
|
|||
|
|
end else begin
|
|||
|
|
Header.ARCount := Header.ARCount + 1;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if IsAdditional then begin
|
|||
|
|
Header.ARCount := Header.ARCount + 1;
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
Header.ANCount := Header.ANCount + 1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Header.Qr := iQr_Answer;
|
|||
|
|
Header.AA := iAA_Authoritative;
|
|||
|
|
Header.RCode := iRCodeNoError;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if RRIndex < (TargetNode.RRs.ItemNames.Count-1) then begin
|
|||
|
|
Stop := False;
|
|||
|
|
Inc(RRIndex);
|
|||
|
|
end else begin
|
|||
|
|
Stop := True;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Stop := True;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if QName = temp_QName then begin
|
|||
|
|
temp_QName := '';
|
|||
|
|
end;
|
|||
|
|
until (RRIndex = -1) or
|
|||
|
|
(not ((not TextIsSame(TargetNode.RRs.ItemNames.Strings[RRIndex], QName)) xor
|
|||
|
|
(not TextIsSame(TargetNode.RRs.ItemNames.Strings[RRIndex], Fetch(temp_QName, '.')))))
|
|||
|
|
or Stop;
|
|||
|
|
|
|||
|
|
// Finish the Loop, but n record is found, we need to search if
|
|||
|
|
// there is a widechar record in its subdomain.
|
|||
|
|
// Main, Cache, Additional, Wildcard
|
|||
|
|
if Length(Answer) > 0 then begin
|
|||
|
|
InternalSearch(Header, '*.' + QName, QType, LocalAnswer, IfMAinQuestion, False, False, True, QName);
|
|||
|
|
if LocalAnswer <> nil then begin
|
|||
|
|
AppendBytes(Answer, LocalAnswer);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin // Node can't be found.
|
|||
|
|
MoreAddrSearch.Clear;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if MoreAddrSearch.Count > 0 then begin
|
|||
|
|
for Count := 0 to MoreAddrSearch.Count -1 do begin
|
|||
|
|
Server_Index := 0;
|
|||
|
|
if Handed_DomainList.Count > 0 then begin
|
|||
|
|
repeat
|
|||
|
|
IsMyDomains := IndyPos(
|
|||
|
|
LowerCase(Handed_DomainList.Strings[Server_Index]),
|
|||
|
|
LowerCase(MoreAddrSearch.Strings[Count])) > 0;
|
|||
|
|
Inc(Server_Index);
|
|||
|
|
until IsMyDomains or (Server_Index > (Handed_DomainList.Count-1));
|
|||
|
|
end else begin
|
|||
|
|
IsMyDomains := False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if IsMyDomains then begin
|
|||
|
|
//ifAdditional := (QType <> TypeCode_A) or (QType <> TypeCode_AAAA);
|
|||
|
|
// modified by Dennies Chang in 2004/7/15.
|
|||
|
|
ifAdditional := (QType <> TypeCode_CName);
|
|||
|
|
|
|||
|
|
//Search A record first.
|
|||
|
|
// Main, Cache, Additional, Wildcard
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A, LocalAnswer, True, False, ifAdditional, False);
|
|||
|
|
{ modified by Dennies Chang in 2004/7/15.
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A,
|
|||
|
|
LocalAnswer, True, ifAdditional, True);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) = 0 then begin
|
|||
|
|
temp := MoreAddrSearch.Strings[Count];
|
|||
|
|
Fetch(temp, '.');
|
|||
|
|
temp := '*.' + temp;
|
|||
|
|
InternalSearch(Header, temp, TypeCode_A, LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
|
|||
|
|
{ marked by Dennies Chang in 2004/7/15.
|
|||
|
|
InternalSearch(Header, temp, TypeCode_A, LocalAnswer, True, ifAdditional, True, True, MoreAddrSearch.Strings[Count]);
|
|||
|
|
}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TempAnswer := LocalAnswer;
|
|||
|
|
|
|||
|
|
// Search for AAAA also.
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA, LocalAnswer, True, False, ifAdditional, True);
|
|||
|
|
{ marked by Dennies Chang in 2004/7/15.
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA, LocalAnswer, True, ifAdditional, True);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) = 0 then begin
|
|||
|
|
temp := MoreAddrSearch.Strings[Count];
|
|||
|
|
Fetch(temp, '.');
|
|||
|
|
temp := '*.' + temp;
|
|||
|
|
InternalSearch(Header, temp, TypeCode_AAAA, LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
|
|||
|
|
{ marked by Dennies Chang in 2004/7/15.
|
|||
|
|
InternalSearch(Header, temp, TypeCode_AAAA, LocalAnswer, True, ifAdditional, True, True, MoreAddrSearch.Strings[Count]);
|
|||
|
|
}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
AppendBytes(TempAnswer, LocalAnswer);
|
|||
|
|
LocalAnswer := TempAnswer;
|
|||
|
|
end else begin
|
|||
|
|
// Need add AAAA Search in future.
|
|||
|
|
//QType := TypeCode_A;
|
|||
|
|
LDNSResolver := TIdDNSResolver.Create(Self);
|
|||
|
|
try
|
|||
|
|
Server_Index := 0;
|
|||
|
|
repeat
|
|||
|
|
LDNSResolver.Host := RootDNS_NET.Strings[Server_Index];
|
|||
|
|
LDNSResolver.QueryType := [qtA];
|
|||
|
|
LDNSResolver.Resolve(MoreAddrSearch.Strings[Count]);
|
|||
|
|
AResult := LDNSResolver.PlainTextResult;
|
|||
|
|
Header.ARCount := Header.ARCount + LDNSResolver.QueryResult.Count;
|
|||
|
|
until (Server_Index >= (RootDNS_NET.Count-1)) or (Length(AResult) > 0);
|
|||
|
|
|
|||
|
|
AppendBytes(LocalAnswer, AResult, 12);
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(LDNSResolver);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) > 0 then begin
|
|||
|
|
AppendBytes(Answer, LocalAnswer);
|
|||
|
|
end;
|
|||
|
|
//Answer := LocalAnswer;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
//Search the Cache Tree;
|
|||
|
|
{ marked by Dennies Chang in 2004/7/15.
|
|||
|
|
{ it's mark for querying cache only.
|
|||
|
|
{ if Length(Answer) = 0 then begin }
|
|||
|
|
TargetNode := SearchTree(Cached_Tree, QName, QType);
|
|||
|
|
if TargetNode <> nil then begin
|
|||
|
|
//Assemble the Answer.
|
|||
|
|
{ modified by Dennies Chang in 2004/7/15}
|
|||
|
|
if (QType in [TypeCode_A, TypeCode_PTR, TypeCode_AAAA, TypeCode_Error, TypeCode_CName]) then begin
|
|||
|
|
QName := Fetch(QName, '.');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
RRIndex := TargetNode.RRs.ItemNames.IndexOf(QName);
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
temp_QName := QName;
|
|||
|
|
SetLength(LocalAnswer, 0);
|
|||
|
|
|
|||
|
|
if RRIndex <> -1 then begin
|
|||
|
|
// TimeOut, update the record.
|
|||
|
|
if CompareDate(Now, StrToDateTime(TargetNode.RRs.Items[RRIndex].TimeOut)) = 1 then begin
|
|||
|
|
SetLength(LocalAnswer, 0);
|
|||
|
|
end else begin
|
|||
|
|
case QType of
|
|||
|
|
TypeCode_Error:
|
|||
|
|
begin
|
|||
|
|
AppendString(Answer, 'Error'); {do not localize}
|
|||
|
|
end;
|
|||
|
|
TypeCode_A:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_A then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_AAAA:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_AAAA then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_NS:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_NS then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_NS).NSDName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MD:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MF:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_CName:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_CName then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_CName).CName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_SOA:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_SOA then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).MName);
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_SOA).RName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MB:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MB then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MB).MADName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MG:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MG then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MG).MGMName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MR:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MR then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MR).NewName);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_NULL:
|
|||
|
|
begin
|
|||
|
|
{
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_NULL then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
end;
|
|||
|
|
TypeCode_WKS:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_WKS then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_PTR:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_PTR then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_HINFO:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_HINFO then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MINFO:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MINFO then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_MX:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_MX then begin
|
|||
|
|
CheckMoreAddrSearch((TargetNode.RRs.Items[RRIndex] as TIdRR_MX).Exchange);
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_TXT:
|
|||
|
|
begin
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_TXT then begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
TypeCode_STAR:
|
|||
|
|
begin
|
|||
|
|
LocalAnswer := TargetNode.RRs.Items[RRIndex].BinQueryRecord(TargetNode.FullName);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if BytesToString(LocalAnswer) = 'Error' then begin {do not localize}
|
|||
|
|
Stop := True;
|
|||
|
|
end else begin
|
|||
|
|
if Length(LocalAnswer) > 0 then begin
|
|||
|
|
AppendBytes(Answer, LocalAnswer);
|
|||
|
|
if TargetNode.RRs.Items[RRIndex] is TIdRR_NS then begin
|
|||
|
|
if IfMainQuestion then begin
|
|||
|
|
Header.ANCount := Header.ANCount + 1;
|
|||
|
|
end else begin
|
|||
|
|
Header.NSCount := Header.NSCount + 1;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if IfMainQuestion then begin
|
|||
|
|
Header.ANCount := Header.ANCount + 1;
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
Header.ARCount := Header.ARCount + 1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Header.Qr := iQr_Answer;
|
|||
|
|
Header.AA := iAA_NotAuthoritative;
|
|||
|
|
Header.RCode := iRCodeNoError;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if RRIndex < (TargetNode.RRs.ItemNames.Count-1) then begin
|
|||
|
|
Stop := False;
|
|||
|
|
Inc(RRIndex);
|
|||
|
|
end else begin
|
|||
|
|
Stop := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Stop := True;
|
|||
|
|
end;
|
|||
|
|
until (RRIndex = -1) or
|
|||
|
|
(not ((not TextIsSame(TargetNode.RRs.ItemNames.Strings[RRIndex], QName)) xor
|
|||
|
|
(not TextIsSame(TargetNode.RRs.ItemNames.Strings[RRIndex], Fetch(temp_QName, '.')))))
|
|||
|
|
or Stop;
|
|||
|
|
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// Search MoreAddrSearch it's added in 2004/7/15, but the need is
|
|||
|
|
// found in 2004 Feb.
|
|||
|
|
if MoreAddrSearch.Count > 0 then begin
|
|||
|
|
for Count := 0 to MoreAddrSearch.Count -1 do begin
|
|||
|
|
Server_Index := 0;
|
|||
|
|
if Handed_DomainList.Count > 0 then begin
|
|||
|
|
repeat
|
|||
|
|
IsMyDomains := IndyPos(
|
|||
|
|
LowerCase(Handed_DomainList.Strings[Server_Index]),
|
|||
|
|
LowerCase(MoreAddrSearch.Strings[Count])) > 0;
|
|||
|
|
Inc(Server_Index);
|
|||
|
|
until IsMyDomains or (Server_Index > (Handed_DomainList.Count-1));
|
|||
|
|
end else begin
|
|||
|
|
IsMyDomains := False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if IsMyDomains then begin
|
|||
|
|
ifAdditional := (QType <> TypeCode_A) or (QType <> TypeCode_AAAA);
|
|||
|
|
|
|||
|
|
//Search A record first.
|
|||
|
|
// Main, Cache, Additional, Wildcard
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A, LocalAnswer, True, False, ifAdditional, False);
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) = 0 then begin
|
|||
|
|
temp := MoreAddrSearch.Strings[Count];
|
|||
|
|
Fetch(temp, '.');
|
|||
|
|
temp := '*.' + temp;
|
|||
|
|
InternalSearch(Header, temp, TypeCode_A, LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TempAnswer := LocalAnswer;
|
|||
|
|
|
|||
|
|
// Search for AAAA also.
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA, LocalAnswer, True, False, ifAdditional, True);
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) = 0 then begin
|
|||
|
|
temp := MoreAddrSearch.Strings[Count];
|
|||
|
|
Fetch(temp, '.');
|
|||
|
|
temp := '*.' + temp;
|
|||
|
|
InternalSearch(Header, temp, TypeCode_AAAA, LocalAnswer, True, False, ifAdditional, True, MoreAddrSearch.Strings[Count]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
AppendBytes(TempAnswer, LocalAnswer);
|
|||
|
|
LocalAnswer := TempAnswer;
|
|||
|
|
end else begin
|
|||
|
|
// <20><>Cache
|
|||
|
|
TempAnswer := LocalAnswer;
|
|||
|
|
ifAdditional := (QType <> TypeCode_A) or (QType <> TypeCode_AAAA);
|
|||
|
|
|
|||
|
|
//Search A record first.
|
|||
|
|
// Main, Cache, Additional, Wildcard
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_A, LocalAnswer, True, True, ifAdditional, False);
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) = 0 then begin
|
|||
|
|
temp := MoreAddrSearch.Strings[Count];
|
|||
|
|
Fetch(temp, '.');
|
|||
|
|
temp := '*.' + temp;
|
|||
|
|
InternalSearch(Header, temp, TypeCode_A, LocalAnswer, True, True, ifAdditional, True, MoreAddrSearch.Strings[Count]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
AppendBytes(TempAnswer, LocalAnswer);
|
|||
|
|
LocalAnswer := TempAnswer;
|
|||
|
|
|
|||
|
|
// Search for AAAA also.
|
|||
|
|
InternalSearch(Header, MoreAddrSearch.Strings[Count], TypeCode_AAAA, LocalAnswer, True, True, ifAdditional, True);
|
|||
|
|
|
|||
|
|
if Length(LocalAnswer) > 0 then begin
|
|||
|
|
AppendBytes(TempAnswer, LocalAnswer);
|
|||
|
|
LocalAnswer := TempAnswer;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Answer := LocalAnswer;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(MoreAddrSearch);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDNSServer }
|
|||
|
|
|
|||
|
|
procedure TIdDNSServer.CheckIfExpire(Sender: TObject);
|
|||
|
|
begin
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNSServer.InitComponent;
|
|||
|
|
begin
|
|||
|
|
inherited InitComponent;
|
|||
|
|
FAccessList := TStringList.Create;
|
|||
|
|
FUDPTunnel := TIdDNS_UDPServer.Create(Self);
|
|||
|
|
FTCPTunnel := TIdDNS_TCPServer.Create(Self);
|
|||
|
|
|
|||
|
|
FBindings := TIdSocketHandles.Create(Self);
|
|||
|
|
FTCPTunnel.DefaultPort := IdPORT_DOMAIN;
|
|||
|
|
FUDPTunnel.DefaultPort := IdPORT_DOMAIN;
|
|||
|
|
ServerType := stPrimary;
|
|||
|
|
BackupDNSMap := TIdDNSMap.Create(FUDPTunnel);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdDNSServer.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FAccessList);
|
|||
|
|
FreeAndNil(FUDPTunnel);
|
|||
|
|
FreeAndNil(FTCPTunnel);
|
|||
|
|
FreeAndNil(FBindings);
|
|||
|
|
FreeAndNil(BackupDNSMap);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNSServer.SetAccessList(const Value: TStrings);
|
|||
|
|
begin
|
|||
|
|
FAccessList.Assign(Value);
|
|||
|
|
FTCPTunnel.AccessList.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNSServer.SetActive(const Value: Boolean);
|
|||
|
|
var
|
|||
|
|
Count : Integer;
|
|||
|
|
DNSMap : TIdDomainNameServerMapping;
|
|||
|
|
begin
|
|||
|
|
FActive := Value;
|
|||
|
|
FUDPTunnel.Active := Value;
|
|||
|
|
if ServerType = stSecondary then begin
|
|||
|
|
TCPTunnel.Active := False;
|
|||
|
|
// TODO: should this loop only be run if Value=True?
|
|||
|
|
for Count := 0 to BackupDNSMap.Count-1 do begin
|
|||
|
|
DNSMap := BackupDNSMap.Items[Count];
|
|||
|
|
DNSMap.CheckScheduler.Start;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
TCPTunnel.Active := Value;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNSServer.SetBindings(const Value: TIdSocketHandles);
|
|||
|
|
begin
|
|||
|
|
FBindings.Assign(Value);
|
|||
|
|
FUDPTunnel.Bindings.Assign(Value);
|
|||
|
|
FTCPTunnel.Bindings.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNSServer.SetTCPACLActive(const Value: Boolean);
|
|||
|
|
begin
|
|||
|
|
FTCPACLActive := Value;
|
|||
|
|
TCPTunnel.AccessControl := Value;
|
|||
|
|
|
|||
|
|
if Value then begin
|
|||
|
|
FTCPTunnel.FAccessList.Assign(FAccessList);
|
|||
|
|
end else begin
|
|||
|
|
FTCPTunnel.FAccessList.Clear;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNSServer.TimeToUpdateNodeData(Sender: TObject);
|
|||
|
|
var
|
|||
|
|
Resolver : TIdDNSResolver;
|
|||
|
|
Count : Integer;
|
|||
|
|
begin
|
|||
|
|
Resolver := TIdDNSResolver.Create(Self);
|
|||
|
|
try
|
|||
|
|
Resolver.Host := UDPTunnel.RootDNS_NET.Strings[0];
|
|||
|
|
Resolver.QueryType := [qtAXFR];
|
|||
|
|
|
|||
|
|
Resolver.Resolve((Sender as TIdDNTreeNode).FullName);
|
|||
|
|
|
|||
|
|
for Count := 0 to Resolver.QueryResult.Count-1 do begin
|
|||
|
|
UDPTunnel.UpdateTree(UDPTunnel.Handed_Tree, Resolver.QueryResult.Items[Count]);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(Resolver);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDNS_TCPServer }
|
|||
|
|
|
|||
|
|
procedure TIdDNS_TCPServer.InitComponent;
|
|||
|
|
begin
|
|||
|
|
inherited InitComponent;
|
|||
|
|
FAccessList := TStringList.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdDNS_TCPServer.Destroy;
|
|||
|
|
begin
|
|||
|
|
FreeAndNil(FAccessList);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_TCPServer.DoConnect(AContext: TIdContext);
|
|||
|
|
var
|
|||
|
|
Answer, Data, Question: TIdBytes;
|
|||
|
|
QName, QLabel, QResult, PeerIP : string;
|
|||
|
|
LData, QPos, LLength : Integer;
|
|||
|
|
TestHeader : TDNSHeader;
|
|||
|
|
|
|||
|
|
procedure GenerateAXFRData;
|
|||
|
|
begin
|
|||
|
|
TestHeader := TDNSHeader.Create;
|
|||
|
|
try
|
|||
|
|
TestHeader.ParseQuery(Data);
|
|||
|
|
if TestHeader.QDCount > 0 then begin
|
|||
|
|
// parse the question.
|
|||
|
|
QPos := 13;
|
|||
|
|
QLabel := '';
|
|||
|
|
QName := '';
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
LLength := Byte(Data[QPos]);
|
|||
|
|
Inc(QPos);
|
|||
|
|
QLabel := BytesToString(Data, QPos, LLength);
|
|||
|
|
Inc(QPos, LLength);
|
|||
|
|
QName := QName + QLabel + '.';
|
|||
|
|
until (QPos >= LData) or (Data[QPos] = 0);
|
|||
|
|
|
|||
|
|
Question := Copy(Data, 13, Length(Data)-12);
|
|||
|
|
QResult := TIdDNSServer(Owner).UDPTunnel.AXFR(TestHeader, QName, Answer);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(TestHeader);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure GenerateAXFRRefuseData;
|
|||
|
|
begin
|
|||
|
|
TestHeader := TDNSHeader.Create;
|
|||
|
|
try
|
|||
|
|
TestHeader.ParseQuery(Data);
|
|||
|
|
TestHeader.Qr := iQr_Answer;
|
|||
|
|
TestHeader.RCode := iRCodeRefused;
|
|||
|
|
Answer := TestHeader.GenerateBinaryHeader;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(TestHeader);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
inherited DoConnect(AContext);
|
|||
|
|
|
|||
|
|
LData := AContext.Connection.IOHandler.ReadInt16;
|
|||
|
|
SetLength(Data, 0);
|
|||
|
|
|
|||
|
|
// RLebeau - why not use ReadBuffer() here?
|
|||
|
|
// Dennies - Sure, in older version, my concern is for real time generate system
|
|||
|
|
// might not generate the data with correct data size we expect.
|
|||
|
|
AContext.Connection.IOHandler.ReadBytes(Data, LData);
|
|||
|
|
{for Count := 1 to LData do begin
|
|||
|
|
AppendByte(Data, AThread.Connection.IOHandler.ReadByte);
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
// PeerIP is ip address.
|
|||
|
|
PeerIP := AContext.Binding.PeerIP;
|
|||
|
|
if AccessControl and (AccessList.IndexOf(PeerIP) = -1) then begin
|
|||
|
|
GenerateAXFRRefuseData;
|
|||
|
|
end else begin
|
|||
|
|
GenerateAXFRData;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(Answer) > 32767 then begin
|
|||
|
|
SetLength(Answer, 32767);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
AContext.Connection.IOHandler.Write(Int16(Length(Answer)));
|
|||
|
|
AContext.Connection.IOHandler.Write(Answer);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_TCPServer.SetAccessList(const Value: TStrings);
|
|||
|
|
begin
|
|||
|
|
FAccessList.Assign(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDomainExpireCheckThread }
|
|||
|
|
|
|||
|
|
procedure TIdDomainExpireCheckThread.Run;
|
|||
|
|
var
|
|||
|
|
LInterval, LStep: Integer;
|
|||
|
|
begin
|
|||
|
|
LInterval := FInterval;
|
|||
|
|
while LInterval > 0 do begin
|
|||
|
|
LStep := IndyMin(LInterval, 500);
|
|||
|
|
IndySleep(LStep);
|
|||
|
|
Dec(LInterval, LStep);
|
|||
|
|
if Terminated then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
if Assigned(FTimerEvent) then begin
|
|||
|
|
Synchronize(TimerEvent);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDomainExpireCheckThread.TimerEvent;
|
|||
|
|
begin
|
|||
|
|
if Assigned(FTimerEvent) then begin
|
|||
|
|
FTimerEvent(FSender);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDomainNameServerMapping }
|
|||
|
|
|
|||
|
|
constructor TIdDomainNameServerMapping.Create(AList : TIdDNSMap);
|
|||
|
|
begin
|
|||
|
|
inherited Create;
|
|||
|
|
|
|||
|
|
CheckScheduler := TIdDomainExpireCheckThread.Create;
|
|||
|
|
CheckScheduler.FInterval := 100000;
|
|||
|
|
CheckScheduler.FSender := Self;
|
|||
|
|
CheckScheduler.FDomain := DomainName;
|
|||
|
|
CheckScheduler.FHost := Host;
|
|||
|
|
CheckScheduler.FTimerEvent := SyncAndUpdate;
|
|||
|
|
|
|||
|
|
FList := List;
|
|||
|
|
FBusy := False;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdDomainNameServerMapping.Destroy;
|
|||
|
|
begin
|
|||
|
|
//Self.CheckScheduler.TerminateAndWaitFor;
|
|||
|
|
CheckScheduler.Terminate;
|
|||
|
|
FreeAndNil(CheckScheduler);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDomainNameServerMapping.SetHost(const Value: string);
|
|||
|
|
begin
|
|||
|
|
if (not IsValidIP(Value)) and (not IsValidIPv6(Value)) then begin
|
|||
|
|
raise EIdDNSServerSettingException.Create(RSDNSServerSettingError_MappingHostError);
|
|||
|
|
end;
|
|||
|
|
FHost := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDomainNameServerMapping.SetInterval(const Value: UInt32);
|
|||
|
|
begin
|
|||
|
|
FInterval := Value;
|
|||
|
|
CheckScheduler.FInterval := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDomainNameServerMapping.SyncAndUpdate(Sender: TObject);
|
|||
|
|
//Todo - Dennies Chang should append axfr and update Tree.
|
|||
|
|
var
|
|||
|
|
Resolver : TIdDNSResolver;
|
|||
|
|
RR : TResultRecord;
|
|||
|
|
TNode : TIdDNTreeNode;
|
|||
|
|
Server : TIdDNS_UDPServer;
|
|||
|
|
NeedUpdated, NotThis : Boolean;
|
|||
|
|
Count, TIndex : Integer;
|
|||
|
|
RRName : string;
|
|||
|
|
begin
|
|||
|
|
if FBusy then begin
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
FBusy := True;
|
|||
|
|
try
|
|||
|
|
Resolver := TIdDNSResolver.Create(nil);
|
|||
|
|
try
|
|||
|
|
Resolver.Host := Host;
|
|||
|
|
Resolver.QueryType := [qtAXFR];
|
|||
|
|
|
|||
|
|
Resolver.Resolve(DomainName);
|
|||
|
|
|
|||
|
|
if Resolver.QueryResult.Count = 0 then begin
|
|||
|
|
raise EIdDNSServerSyncException.Create(RSDNSServerAXFRError_QuerySequenceError);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
RR := Resolver.QueryResult.Items[0];
|
|||
|
|
if RR.RecType <> qtSOA then begin
|
|||
|
|
raise EIdDNSServerSyncException.Create(RSDNSServerAXFRError_QuerySequenceError);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Server := List.Server;
|
|||
|
|
Interval := TSOARecord(RR).Expire * 1000;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
//Update MyDomain
|
|||
|
|
if Copy(RR.Name, Length(RR.Name),1) <> '.' then begin
|
|||
|
|
RRName := RR.Name + '.';
|
|||
|
|
end;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if Server.Handed_DomainList.IndexOf(RR.Name) = -1 then begin
|
|||
|
|
Server.Handed_DomainList.Add(RR.Name);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TNode := Server.SearchTree(Server.Handed_Tree, RR.Name, TypeCode_SOA);
|
|||
|
|
|
|||
|
|
if TNode = nil then begin
|
|||
|
|
NeedUpdated := True;
|
|||
|
|
end else begin
|
|||
|
|
RRName := RRName;
|
|||
|
|
RRName := Fetch(RRName, '.');
|
|||
|
|
TIndex := TNode.RRs.ItemNames.IndexOf(RR.Name);
|
|||
|
|
NotThis := True;
|
|||
|
|
|
|||
|
|
while (TIndex > -1) and (TIndex <= (TNode.RRs.Count-1)) and
|
|||
|
|
(TNode.RRs.Items[TIndex].RRName = RR.Name) and NotThis do
|
|||
|
|
begin
|
|||
|
|
NotThis := not (TNode.RRs.Items[TIndex] is TIdRR_SOA);
|
|||
|
|
Inc(TIndex);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if not NotThis then begin
|
|||
|
|
Dec(TIndex);
|
|||
|
|
NeedUpdated := (TNode.RRs.Items[TIndex] as TIdRR_SOA).Serial = IntToStr(TSOARecord(RR).Serial);
|
|||
|
|
end else begin
|
|||
|
|
NeedUpdated := True;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if NeedUpdated then begin
|
|||
|
|
if TNode <> nil then begin
|
|||
|
|
Server.Handed_Tree.RemoveChild(Server.Handed_Tree.IndexByNode(TNode));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
for Count := 0 to Resolver.QueryResult.Count-1 do begin
|
|||
|
|
RR := Resolver.QueryResult.Items[Count];
|
|||
|
|
Server.UpdateTree(Server.Handed_Tree, RR);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(Resolver);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FBusy := False;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDNSMap }
|
|||
|
|
|
|||
|
|
constructor TIdDNSMap.Create(Server: TIdDNS_UDPServer);
|
|||
|
|
begin
|
|||
|
|
inherited Create;
|
|||
|
|
FServer := Server;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{$IFNDEF USE_OBJECT_ARC}
|
|||
|
|
destructor TIdDNSMap.Destroy;
|
|||
|
|
var
|
|||
|
|
I : Integer;
|
|||
|
|
DNSMP : TIdDomainNameServerMapping;
|
|||
|
|
begin
|
|||
|
|
if Count > 0 then begin
|
|||
|
|
for I := Count-1 downto 0 do begin
|
|||
|
|
DNSMP := Items[I];
|
|||
|
|
FreeAndNil(DNSMP);
|
|||
|
|
Delete(I);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
|
|||
|
|
{$IFNDEF HAS_GENERICS_TObjectList}
|
|||
|
|
function TIdDNSMap.GetItem(Index: Integer): TIdDomainNameServerMapping;
|
|||
|
|
begin
|
|||
|
|
Result := TIdDomainNameServerMapping(inherited GetItem(Index));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNSMap.SetItem(Index: Integer; const Value: TIdDomainNameServerMapping);
|
|||
|
|
begin
|
|||
|
|
inherited SetItem(Index, Value);
|
|||
|
|
end;
|
|||
|
|
{$ENDIF}
|
|||
|
|
|
|||
|
|
procedure TIdDNSMap.SetServer(const Value: TIdDNS_UDPServer);
|
|||
|
|
begin
|
|||
|
|
FServer := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TIdDNS_ProcessThread }
|
|||
|
|
|
|||
|
|
constructor TIdDNS_ProcessThread.Create(ACreateSuspended: Boolean;
|
|||
|
|
Data: TIdBytes; MainBinding, Binding: TIdSocketHandle;
|
|||
|
|
Server: TIdDNS_UDPServer);
|
|||
|
|
begin
|
|||
|
|
inherited Create(ACreateSuspended);
|
|||
|
|
|
|||
|
|
FMyData := nil;
|
|||
|
|
FData := Data;
|
|||
|
|
|
|||
|
|
FMyBinding := Binding;
|
|||
|
|
FMainBinding := MainBinding;
|
|||
|
|
|
|||
|
|
FServer := Server;
|
|||
|
|
FreeOnTerminate := True;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.ComposeErrorResult(var VFinal: TIdBytes;
|
|||
|
|
OriginalHeader: TDNSHeader; OriginalQuestion : TIdBytes;
|
|||
|
|
ErrorStatus: Integer);
|
|||
|
|
begin
|
|||
|
|
case ErrorStatus of
|
|||
|
|
iRCodeQueryNotImplement :
|
|||
|
|
begin
|
|||
|
|
OriginalHeader.Qr := iQr_Answer;
|
|||
|
|
OriginalHeader.RCode := iRCodeNotImplemented;
|
|||
|
|
|
|||
|
|
VFinal := OriginalHeader.GenerateBinaryHeader;
|
|||
|
|
AppendBytes(VFinal, OriginalQuestion, 12);
|
|||
|
|
end;
|
|||
|
|
iRCodeQueryNotFound :
|
|||
|
|
begin
|
|||
|
|
OriginalHeader.Qr := iQr_Answer;
|
|||
|
|
OriginalHeader.RCode := iRCodeNameError;
|
|||
|
|
OriginalHeader.ANCount := 0;
|
|||
|
|
|
|||
|
|
VFinal := OriginalHeader.GenerateBinaryHeader;
|
|||
|
|
//VFinal := VFinal;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TIdDNS_ProcessThread.Destroy;
|
|||
|
|
begin
|
|||
|
|
FServer := nil;
|
|||
|
|
FMainBinding := nil;
|
|||
|
|
FMyBinding.CloseSocket;
|
|||
|
|
FreeAndNil(FMyBinding);
|
|||
|
|
FreeAndNil(FMyData);
|
|||
|
|
inherited Destroy;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.QueryDomain;
|
|||
|
|
var
|
|||
|
|
QName, QLabel, RString : string;
|
|||
|
|
Temp, ExternalQuery, Answer, FinalResult : TIdBytes;
|
|||
|
|
DNSHeader_Processing : TDNSHeader;
|
|||
|
|
QType, QClass : UInt16;
|
|||
|
|
QPos, QLength, LLength : Integer;
|
|||
|
|
ABinding: TIdSocketHandle;
|
|||
|
|
begin
|
|||
|
|
ExternalQuery := FData;
|
|||
|
|
ABinding := MyBinding;
|
|||
|
|
Temp := Copy(FData, 0, Length(FData));
|
|||
|
|
SetLength(FinalResult, 0);
|
|||
|
|
QType := TypeCode_A;
|
|||
|
|
|
|||
|
|
if Length(FData) >= 12 then begin
|
|||
|
|
DNSHeader_Processing := TDNSHeader.Create;
|
|||
|
|
try
|
|||
|
|
// RLebeau: this does not make sense to me. ParseQuery() always returns
|
|||
|
|
// 0 when the data length is >= 12 unless an exception is raised, which
|
|||
|
|
// should only happen if the GStack object is invalid...
|
|||
|
|
//
|
|||
|
|
if DNSHeader_Processing.ParseQuery(ExternalQuery) <> 0 then begin
|
|||
|
|
FServer.DoAfterQuery(ABinding, DNSHeader_Processing, Temp, RString, ExternalQuery);
|
|||
|
|
AppendBytes(FinalResult, Temp);
|
|||
|
|
end else begin
|
|||
|
|
if DNSHeader_Processing.QDCount > 0 then begin
|
|||
|
|
|
|||
|
|
QPos := 12; //13; Modified in Dec. 13, 2004 by Dennies
|
|||
|
|
QLength := Length(ExternalQuery);
|
|||
|
|
if QLength > 12 then begin
|
|||
|
|
QName := '';
|
|||
|
|
repeat
|
|||
|
|
SetLength(Answer, 0);
|
|||
|
|
LLength := ExternalQuery[QPos];
|
|||
|
|
Inc(QPos);
|
|||
|
|
QLabel := BytesToString(ExternalQuery, QPos, LLength);
|
|||
|
|
Inc(QPos, LLength);
|
|||
|
|
QName := QName + QLabel + '.';
|
|||
|
|
until (QPos >= QLength) or (ExternalQuery[QPos] = 0);
|
|||
|
|
Inc(QPos);
|
|||
|
|
|
|||
|
|
QType := GStack.NetworkToHost(TwoByteToUInt16(ExternalQuery[QPos], ExternalQuery[QPos + 1]));
|
|||
|
|
Inc(QPos, 2);
|
|||
|
|
QClass := GStack.NetworkToHost(TwoByteToUInt16(ExternalQuery[QPos], ExternalQuery[QPos + 1]));
|
|||
|
|
FServer.DoBeforeQuery(ABinding, DNSHeader_Processing, Temp);
|
|||
|
|
|
|||
|
|
RString := CompleteQuery(DNSHeader_Processing, QName, ExternalQuery, Answer, QType, QClass, nil);
|
|||
|
|
|
|||
|
|
if RString = cRCodeQueryNotImplement then begin
|
|||
|
|
ComposeErrorResult(FinalResult, DNSHeader_Processing, ExternalQuery, iRCodeQueryNotImplement);
|
|||
|
|
end
|
|||
|
|
else if (RString = cRCodeQueryReturned) then begin
|
|||
|
|
FinalResult := Answer;
|
|||
|
|
end
|
|||
|
|
else if (RString = cRCodeQueryNotFound) or (RString = cRCodeQueryCacheFindError) then begin
|
|||
|
|
ComposeErrorResult(FinalResult, DNSHeader_Processing, ExternalQuery, iRCodeQueryNotFound);
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
FinalResult := CombineAnswer(DNSHeader_Processing, ExternalQuery, Answer);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
FServer.DoAfterQuery(ABinding, DNSHeader_Processing, FinalResult, RString, Temp);
|
|||
|
|
//AppendString(FinalResult, Temp);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
try
|
|||
|
|
FData := FinalResult;
|
|||
|
|
|
|||
|
|
FServer.DoAfterSendBack(ABinding, DNSHeader_Processing, FinalResult, RString, ExternalQuery);
|
|||
|
|
|
|||
|
|
if (FServer.CacheUnknowZone) and
|
|||
|
|
(RString <> cRCodeQueryCacheFindError) and
|
|||
|
|
(RString <> cRCodeQueryCacheOK) and
|
|||
|
|
(RString <> cRCodeQueryOK) and
|
|||
|
|
(RString <> cRCodeQueryNotImplement) then
|
|||
|
|
begin
|
|||
|
|
FServer.SaveToCache(FinalResult, QName, QType);
|
|||
|
|
FServer.DoAfterCacheSaved(Self.FServer.FCached_Tree);
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(DNSHeader_Processing);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.Run;
|
|||
|
|
begin
|
|||
|
|
try
|
|||
|
|
QueryDomain;
|
|||
|
|
SendData;
|
|||
|
|
finally
|
|||
|
|
Stop;
|
|||
|
|
Terminate;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.SetMyBinding(const Value: TIdSocketHandle);
|
|||
|
|
begin
|
|||
|
|
FMyBinding := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.SetMyData(const Value: TStream);
|
|||
|
|
begin
|
|||
|
|
FMyData := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.SetServer(const Value: TIdDNS_UDPServer);
|
|||
|
|
begin
|
|||
|
|
FServer := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_ProcessThread.CombineAnswer(Header: TDNSHeader; const EQuery, Answer: TIdBytes): TIdBytes;
|
|||
|
|
begin
|
|||
|
|
Result := Header.GenerateBinaryHeader;
|
|||
|
|
AppendBytes(Result, EQuery, 12);
|
|||
|
|
AppendBytes(Result, Answer);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.ExternalSearch(ADNSResolver: TIdDNSResolver; Header: TDNSHeader;
|
|||
|
|
Question: TIdBytes; var Answer: TIdBytes);
|
|||
|
|
var
|
|||
|
|
Server_Index : Integer;
|
|||
|
|
MyDNSResolver : TIdDNSResolver;
|
|||
|
|
begin
|
|||
|
|
Server_Index := 0;
|
|||
|
|
if ADNSResolver = nil then begin
|
|||
|
|
MyDNSResolver := TIdDNSResolver.Create;
|
|||
|
|
MyDNSResolver.WaitingTime := 2000;
|
|||
|
|
end else
|
|||
|
|
begin
|
|||
|
|
MyDNSResolver := ADNSResolver;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
try
|
|||
|
|
repeat
|
|||
|
|
MyDNSResolver.Host := FServer.RootDNS_NET.Strings[Server_Index];
|
|||
|
|
try
|
|||
|
|
MyDNSResolver.InternalQuery := Question;
|
|||
|
|
MyDNSResolver.Resolve('');
|
|||
|
|
Answer := MyDNSResolver.PlainTextResult;
|
|||
|
|
except
|
|||
|
|
// Todo: Create DNS server interal resolver error.
|
|||
|
|
on EIdDnsResolverError do
|
|||
|
|
begin
|
|||
|
|
//Empty Event, for user to custom the event handle.
|
|||
|
|
end;
|
|||
|
|
on EIdSocketError do
|
|||
|
|
begin
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Inc(Server_Index);
|
|||
|
|
until (Server_Index >= FServer.RootDNS_NET.Count) or (Length(Answer) > 0);
|
|||
|
|
finally
|
|||
|
|
if ADNSResolver = nil then begin
|
|||
|
|
FreeAndNil(MyDNSResolver);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.InternalSearch(Header: TDNSHeader; QName: string; QType: UInt16;
|
|||
|
|
var Answer: TIdBytes; IfMainQuestion: boolean; IsSearchCache: Boolean = False;
|
|||
|
|
IsAdditional: boolean = false; IsWildCard : boolean = false;
|
|||
|
|
WildCardOrgName: string = '');
|
|||
|
|
begin
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.SaveToCache(ResourceRecord: TIdBytes; QueryName: string; OriginalQType: UInt16);
|
|||
|
|
var
|
|||
|
|
TempResolver : TIdDNSResolver;
|
|||
|
|
Count : Integer;
|
|||
|
|
TNode : TIdDNTreeNode;
|
|||
|
|
RR_Err : TIdRR_Error;
|
|||
|
|
begin
|
|||
|
|
TempResolver := TIdDNSResolver.Create(nil);
|
|||
|
|
try
|
|||
|
|
// RLebeau: FillResultWithOutCheckId() is deprecated, but not using FillResult()
|
|||
|
|
// here yet because it validates the DNSHeader.RCode, and I do not know if that
|
|||
|
|
// is needed here. I don't want to break this logic...
|
|||
|
|
TempResolver.FillResultWithOutCheckId(ResourceRecord);
|
|||
|
|
|
|||
|
|
if TempResolver.DNSHeader.ANCount > 0 then begin
|
|||
|
|
for Count := 0 to TempResolver.QueryResult.Count-1 do begin
|
|||
|
|
FServer.UpdateTree(FServer.Cached_Tree, TempResolver.QueryResult.Items[Count]);
|
|||
|
|
end; // for loop
|
|||
|
|
end else begin
|
|||
|
|
TNode := Self.SearchTree(FServer.Cached_Tree, QueryName, TypeCode_Error);
|
|||
|
|
if TNode = nil then begin
|
|||
|
|
RR_Err := TIdRR_Error.Create;
|
|||
|
|
RR_Err.RRName := QueryName;
|
|||
|
|
RR_Err.TTL := 600;
|
|||
|
|
FServer.UpdateTree(FServer.Cached_Tree, RR_Err);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(TempResolver);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_ProcessThread.SearchTree(Root: TIdDNTreeNode; QName: String; QType: UInt16): TIdDNTreeNode;
|
|||
|
|
var
|
|||
|
|
RRIndex : integer;
|
|||
|
|
NodeCursor : TIdDNTreeNode;
|
|||
|
|
NameLabels : TStrings;
|
|||
|
|
OneNode, FullName : string;
|
|||
|
|
Found : Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := nil;
|
|||
|
|
NameLabels := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
FullName := QName;
|
|||
|
|
NodeCursor := Root;
|
|||
|
|
Found := False;
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
OneNode := Fetch(FullName, '.');
|
|||
|
|
if OneNode <> '' then begin
|
|||
|
|
NameLabels.Add(OneNode);
|
|||
|
|
end;
|
|||
|
|
until FullName = '';
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
IndySleep(0);
|
|||
|
|
if QType <> TypeCode_SOA then begin
|
|||
|
|
RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
|
|||
|
|
if RRIndex <> -1 then begin
|
|||
|
|
NameLabels.Delete(NameLabels.Count - 1);
|
|||
|
|
NodeCursor := NodeCursor.Children[RRIndex];
|
|||
|
|
|
|||
|
|
if NameLabels.Count = 1 then begin
|
|||
|
|
Found := NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1;
|
|||
|
|
end else begin
|
|||
|
|
Found := NameLabels.Count = 0;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if NameLabels.Count = 1 then begin
|
|||
|
|
Found := NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1;
|
|||
|
|
if not Found then begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
RRIndex := NodeCursor.ChildIndex.IndexOf(NameLabels.Strings[NameLabels.Count - 1]);
|
|||
|
|
if RRIndex <> -1 then begin
|
|||
|
|
NameLabels.Delete(NameLabels.Count - 1);
|
|||
|
|
NodeCursor := NodeCursor.Children[RRIndex];
|
|||
|
|
|
|||
|
|
if NameLabels.Count = 1 then begin
|
|||
|
|
Found := NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1;
|
|||
|
|
end else begin
|
|||
|
|
Found := NameLabels.Count = 0;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else if NameLabels.Count = 1 then begin
|
|||
|
|
Found := (NodeCursor.RRs.ItemNames.IndexOf(NameLabels.Strings[0]) <> -1);
|
|||
|
|
if not Found then begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end
|
|||
|
|
else begin
|
|||
|
|
NameLabels.Clear;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
until (NameLabels.Count = 0) or Found;
|
|||
|
|
|
|||
|
|
if Found then begin
|
|||
|
|
Result := NodeCursor;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
FreeAndNil(NameLabels);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TIdDNS_ProcessThread.CompleteQuery(DNSHeader: TDNSHeader;
|
|||
|
|
Question: string; OriginalQuestion: TIdBytes; var Answer : TIdBytes;
|
|||
|
|
QType, QClass : UInt16; DNSResolver : TIdDNSResolver) : string;
|
|||
|
|
var
|
|||
|
|
IsMyDomains : boolean;
|
|||
|
|
LAnswer, TempAnswer, RRData: TIdBytes;
|
|||
|
|
WildQuestion, TempDomain : string;
|
|||
|
|
LIdx: Integer;
|
|||
|
|
begin
|
|||
|
|
// QClass = 1 => IN, we support only "IN" class now.
|
|||
|
|
// QClass = 2 => CS,
|
|||
|
|
// QClass = 3 => CH, we suppor "CHAOS" class now, but only "version.bind." info.
|
|||
|
|
// from 2004/6/28
|
|||
|
|
// QClass = 4 => HS.
|
|||
|
|
RRData := nil;
|
|||
|
|
TempAnswer := nil;
|
|||
|
|
TempDomain := LowerCase(Question);
|
|||
|
|
|
|||
|
|
case QClass of
|
|||
|
|
Class_IN :
|
|||
|
|
begin
|
|||
|
|
IsMyDomains := FServer.Handed_DomainList.IndexOf(TempDomain) > -1;
|
|||
|
|
if not IsMyDomains then begin
|
|||
|
|
Fetch(TempDomain, '.');
|
|||
|
|
IsMyDomains := FServer.Handed_DomainList.IndexOf(TempDomain) > -1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if IsMyDomains then begin
|
|||
|
|
FServer.InternalSearch(DNSHeader, Question, QType, LAnswer, True, False, False);
|
|||
|
|
Answer := LAnswer;
|
|||
|
|
|
|||
|
|
if (QType in [TypeCode_A, TypeCode_AAAA]) and (Length(Answer) = 0) then begin
|
|||
|
|
FServer.InternalSearch(DNSHeader, Question, TypeCode_CNAME, LAnswer, True, False, True);
|
|||
|
|
if Length(LAnswer) > 0 then begin
|
|||
|
|
AppendBytes(Answer, LAnswer);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
WildQuestion := Question;
|
|||
|
|
Fetch(WildQuestion, '.');
|
|||
|
|
WildQuestion := '*.' + WildQuestion;
|
|||
|
|
FServer.InternalSearch(DNSHeader, WildQuestion, QType, LAnswer, True, False, False, True, Question);
|
|||
|
|
{
|
|||
|
|
FServer.InternalSearch(DNSHeader, Question, QType, LAnswer, True, True, False);
|
|||
|
|
}
|
|||
|
|
if Length(LAnswer) > 0 then begin
|
|||
|
|
AppendBytes(Answer, LAnswer);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(Answer) > 0 then begin
|
|||
|
|
Result := cRCodeQueryOK;
|
|||
|
|
end else begin
|
|||
|
|
Result := cRCodeQueryNotFound;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
FServer.InternalSearch(DNSHeader, Question, QType, Answer, True, True, False);
|
|||
|
|
|
|||
|
|
if (QType in [TypeCode_A, TypeCode_AAAA]) and (Length(Answer) = 0) then begin
|
|||
|
|
FServer.InternalSearch(DNSHeader, Question, TypeCode_CNAME, LAnswer, True, True, False);
|
|||
|
|
if Length(LAnswer) > 0 then begin
|
|||
|
|
AppendBytes(Answer, LAnswer);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if Length(Answer) > 0 then begin
|
|||
|
|
Result := cRCodeQueryCacheOK;
|
|||
|
|
end else begin
|
|||
|
|
//QType := TypeCode_Error;
|
|||
|
|
|
|||
|
|
FServer.InternalSearch(DNSHeader, Question, QType, Answer, True, True, False);
|
|||
|
|
if BytesToString(Answer) = 'Error' then begin {do not localize}
|
|||
|
|
Result := cRCodeQueryCacheFindError;
|
|||
|
|
end else begin
|
|||
|
|
FServer.ExternalSearch(DNSResolver, DNSHeader, OriginalQuestion, Answer);
|
|||
|
|
|
|||
|
|
if Length(Answer) > 0 then begin
|
|||
|
|
Result := cRCodeQueryReturned;
|
|||
|
|
end else begin
|
|||
|
|
Result := cRCodeQueryNotImplement;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
Class_CHAOS :
|
|||
|
|
begin
|
|||
|
|
if TempDomain = 'version.bind.' then begin {do not localize}
|
|||
|
|
if FServer.offerDNSVersion then begin
|
|||
|
|
TempAnswer := DomainNameToDNSStr('version.bind.'); {do not localize}
|
|||
|
|
RRData := NormalStrToDNSStr(FServer.DNSVersion);
|
|||
|
|
|
|||
|
|
SetLength(LAnswer, Length(TempAnswer) + (SizeOf(UInt16)*3) + SizeOf(UInt32) + Length(RRData));
|
|||
|
|
CopyTIdBytes(TempAnswer, 0, LAnswer, 0, Length(TempAnswer));
|
|||
|
|
LIdx := Length(TempAnswer);
|
|||
|
|
CopyTIdUInt16(GStack.HostToNetwork(UInt16(TypeCode_TXT)), LAnswer, LIdx);
|
|||
|
|
Inc(LIdx, SizeOf(UInt16));
|
|||
|
|
CopyTIdUInt16(GStack.HostToNetwork(UInt16(Class_CHAOS)), LAnswer, LIdx);
|
|||
|
|
Inc(LIdx, SizeOf(UInt16));
|
|||
|
|
CopyTIdUInt32(GStack.HostToNetwork(UInt32(86400)), LAnswer, LIdx); {do not localize}
|
|||
|
|
Inc(LIdx, SizeOf(UInt32));
|
|||
|
|
CopyTIdUInt16(GStack.HostToNetwork(UInt16(Length(RRData))), LAnswer, LIdx);
|
|||
|
|
Inc(LIdx, SizeOf(UInt16));
|
|||
|
|
CopyTIdBytes(RRData, 0, LAnswer, LIdx, Length(RRData));
|
|||
|
|
|
|||
|
|
Answer := LAnswer;
|
|||
|
|
DNSHeader.ANCount := 1;
|
|||
|
|
DNSHeader.AA := 1;
|
|||
|
|
Result := cRCodeQueryOK;
|
|||
|
|
end else begin
|
|||
|
|
Result := cRCodeQueryNotImplement;
|
|||
|
|
end;
|
|||
|
|
end else begin
|
|||
|
|
Result := cRCodeQueryNotImplement;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
Result := cRCodeQueryNotImplement;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_ProcessThread.SendData;
|
|||
|
|
begin
|
|||
|
|
FServer.GlobalCS.Enter;
|
|||
|
|
try
|
|||
|
|
FMainBinding.SendTo(FMyBinding.PeerIP, FMyBinding.PeerPort, FData, FMyBinding.IPVersion);
|
|||
|
|
finally
|
|||
|
|
FServer.GlobalCS.Leave;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.DoAfterCacheSaved(CacheRoot: TIdDNTreeNode);
|
|||
|
|
begin
|
|||
|
|
if Assigned(FOnAfterCacheSaved) then begin
|
|||
|
|
FOnAfterCacheSaved(CacheRoot);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TIdDNS_UDPServer.DoUDPRead(AThread: TIdUDPListenerThread;
|
|||
|
|
const AData: TIdBytes; ABinding: TIdSocketHandle);
|
|||
|
|
var
|
|||
|
|
PThread : TIdDNS_ProcessThread;
|
|||
|
|
BBinding : TIdSocketHandle;
|
|||
|
|
Binded : Boolean;
|
|||
|
|
begin
|
|||
|
|
inherited DoUDPRead(AThread, AData, ABinding);
|
|||
|
|
|
|||
|
|
Binded := False;
|
|||
|
|
|
|||
|
|
BBinding := TIdSocketHandle.Create(nil);
|
|||
|
|
try
|
|||
|
|
BBinding.SetPeer(ABinding.PeerIP, ABinding.PeerPort, ABinding.IPVersion);
|
|||
|
|
BBinding.IP := ABinding.IP;
|
|||
|
|
|
|||
|
|
repeat
|
|||
|
|
try
|
|||
|
|
BBinding.Port := 53;
|
|||
|
|
BBinding.AllocateSocket(Id_SOCK_DGRAM);
|
|||
|
|
Binded := True;
|
|||
|
|
except
|
|||
|
|
end;
|
|||
|
|
until Binded;
|
|||
|
|
|
|||
|
|
PThread := TIdDNS_ProcessThread.Create(True, AData, ABinding, BBinding, Self);
|
|||
|
|
except
|
|||
|
|
FreeAndNil(BBinding);
|
|||
|
|
raise;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
PThread.Start;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
end.
|