www.pudn.com > indyprelim.zip > IdIcmpClient.pas
{
$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.8 2004-04-25 12:08:24 Mattias
Fixed multithreading issue
Rev 1.7 2004.02.03 4:16:42 PM czhower
For unit name changes.
Rev 1.6 2/1/2004 4:53:30 PM JPMugaas
Removed Todo;
Rev 1.5 2004.01.20 10:03:24 PM czhower
InitComponent
Rev 1.4 2003.12.31 10:37:54 PM czhower
GetTickcount --> Ticks
Rev 1.3 10/16/2003 11:06:14 PM SPerry
Moved ICMP_MIN to IdRawHeaders
Rev 1.2 2003.10.11 5:48:04 PM czhower
-VCL fixes for servers
-Chain suport for servers (Super core)
-Scheduler upgrades
-Full yarn support
Rev 1.1 2003.09.30 1:22:56 PM czhower
Stack split for DotNet
Rev 1.0 11/13/2002 08:44:30 AM JPMugaas
25/1/02: SGrobety:
Modified the component to support multithreaded PING and traceroute
NOTE!!!
The component no longer use the timing informations contained
in the packet to compute the roundtrip time. This is because
that information is only correctly set in case of ECHOREPLY
In case of TTL, it is incorrect.
}
unit IdIcmpClient;
{
Note that we can NOT remove the DotNET IFDEFS from this unit. The reason is
that Microsoft NET Framework 1.1 does not support ICMPv6 and that's required
for IPv6. In Win32 and Linux, we definately can and want to support IPv6.
If we support a later version of the NET framework that has a better API, I may
consider revisiting this.
}
// SG 25/1/02: Modified the component to support multithreaded PING and traceroute
interface
{$I IdCompilerDefines.inc}
//Put FPC into Delphi mode
uses
IdGlobal,
IdObjs,
IdRawBase,
IdRawClient,
IdStackConsts,
IdBaseComponent,
IdSys;
const
DEF_PACKET_SIZE = 32;
MAX_PACKET_SIZE = 1024;
iDEFAULTPACKETSIZE = 128;
iDEFAULTREPLYBUFSIZE = 1024;
Id_TIDICMP_ReceiveTimeout = 5000;
type
TReplyStatusTypes = (rsEcho,
rsError, rsTimeOut, rsErrorUnreachable,
rsErrorTTLExceeded,rsErrorPacketTooBig,
rsErrorParameter,
rsErrorDatagramConversion,
rsErrorSecurityFailure,
rsSourceQuench,
rsRedirect,
rsTimeStamp,
rsInfoRequest,
rsAddressMaskRequest,
rsTraceRoute,
rsMobileHostReg,
rsMobileHostRedir,
rsIPv6WhereAreYou,
rsIPv6IAmHere,
rsSKIP);
TReplyStatus = class(TObject)
protected
FBytesReceived: integer; // number of bytes in reply from host
FFromIpAddress: string; // IP address of replying host
FToIpAddress : string; //who receives it (i.e., us. This is for multihorned machines
FMsgType: byte;
FMsgCode : Byte;
FSequenceId: word; // sequence id of ping reply
// TODO: roundtrip time in ping reply should be float, not byte
FMsRoundTripTime: longword; // ping round trip time in milliseconds
FTimeToLive: byte; // time to live
FReplyStatusType: TReplyStatusTypes;
FPacketNumber : Integer;//number in packet for TraceRoute
FHostName : String; //Hostname of computer that replied, used with TraceRoute
FMsg : String;
FRedirectTo : String; // valid only for rsRedirect
public
property RedirectTo : String read FRedirectTo write FRedirectTo;
property Msg : String read FMsg write FMsg;
property BytesReceived: integer read FBytesReceived write FBytesReceived; // number of bytes in reply from host
property FromIpAddress: string read FFromIpAddress write FFromIpAddress; // IP address of replying host
property ToIpAddress : string read FToIpAddress write FToIpAddress; //who receives it (i.e., us. This is for multihorned machines
property MsgType: byte read FMsgType write FMsgType;
property MsgCode : Byte read FMsgCode write FMsgCode;
property SequenceId: word read FSequenceId write FSequenceId; // sequence id of ping reply
// TODO: roundtrip time in ping reply should be float, not byte
property MsRoundTripTime: longword read FMsRoundTripTime write FMsRoundTripTime; // ping round trip time in milliseconds
property TimeToLive: byte read FTimeToLive write FTimeToLive; // time to live
property ReplyStatusType: TReplyStatusTypes read FReplyStatusType write FReplyStatusType;
property HostName : String read FHostName write FHostName;
property PacketNumber : Integer read FPacketNumber write FPacketNumber;
end;
TOnReplyEvent = procedure(ASender: TIdNativeComponent; const AReplyStatus: TReplyStatus) of object;
TIdCustomIcmpClient = class(TIdRawClient)
protected
FStartTime : Cardinal; //this is a fallabk if no packet is returned
FPacketSize : Integer;
FbufReceive: TIdBytes;
FbufIcmp: TIdBytes;
wSeqNo: word;
iDataSize: integer;
FReplyStatus: TReplyStatus;
FOnReply: TOnReplyEvent;
FReplydata: String;
//
{$IFNDEF DOTNET}
function DecodeIPv6Packet(BytesRead: Cardinal; var AReplyStatus: TReplyStatus): boolean;
{$ENDIF}
function DecodeIPv4Packet(BytesRead: Cardinal; var AReplyStatus: TReplyStatus): boolean;
function DecodeResponse(BytesRead: Cardinal; var AReplyStatus: TReplyStatus): boolean;
procedure DoReply(const AReplyStatus: TReplyStatus); virtual;
procedure GetEchoReply;
procedure InitComponent; override;
{$IFNDEF DOTNET}
procedure PrepareEchoRequestIPv6(Buffer: String);
{$ENDIF}
procedure PrepareEchoRequestIPv4(Buffer : String='');
procedure PrepareEchoRequest(Buffer: string = ''); {Do not Localize}
procedure SendEchoRequest; overload;
procedure SendEchoRequest(const AIP : String); overload;
function GetPacketSize: Integer;
procedure SetPacketSize(const AValue: Integer);
//these are made public in the client
procedure InternalPing(const AIP : String; const ABuffer: String = ''; SequenceID: word = 0); {Do not Localize} overload;
//
property PacketSize : Integer read GetPacketSize write SetPacketSize;
property ReplyData: string read FReplydata;
property ReplyStatus: TReplyStatus read FReplyStatus;
public
destructor Destroy; override;
procedure Send(const AHost: string; const APort: integer; const ABuffer : TIdBytes); override;
procedure Send(const ABuffer : TIdBytes); override;
function Receive(ATimeOut: Integer): TReplyStatus;
end;
TIdIcmpClient = class(TIdCustomIcmpClient)
public
procedure Ping(const ABuffer: String = ''; SequenceID: word = 0); {Do not Localize}
property ReplyData;
property ReplyStatus;
published
property Host;
{$IFNDEF DOTNET}
property IPVersion;
{$ENDIF}
property PacketSize;
property ReceiveTimeout default Id_TIDICMP_ReceiveTimeout;
property OnReply: TOnReplyEvent read FOnReply write FOnReply;
end;
implementation
uses
IdExceptionCore, IdRawHeaders, IdResourceStringsCore,
IdStack;
procedure TIdCustomIcmpClient.PrepareEchoRequest(Buffer: string = ''); {Do not Localize}
begin
{$IFNDEF DOTNET}
if IPVersion = Id_IPv4 then
begin
PrepareEchoRequestIPv4(Buffer);
end
else
begin
PrepareEchoRequestIPv6(Buffer);
end;
{$ELSE}
PrepareEchoRequestIPv4(Buffer);
{$ENDIF}
end;
procedure TIdCustomIcmpClient.SendEchoRequest;
begin
Send(FbufIcmp);
end;
function TIdCustomIcmpClient.DecodeResponse(BytesRead: Cardinal; var AReplyStatus: TReplyStatus): Boolean;
begin
if BytesRead = 0 then begin
// Timed out
AReplyStatus.MsRoundTripTime := Ticks - FStartTime;
if Self.IPVersion = Id_IPv4 then
begin
AReplyStatus.BytesReceived := 0;
AReplyStatus.FromIpAddress := '0.0.0.0';
AReplyStatus.ToIpAddress := '0.0.0.0';
AReplyStatus.MsgType := 0;
AReplyStatus.SequenceId := wSeqNo;
AReplyStatus.TimeToLive := 0;
AReplyStatus.ReplyStatusType := rsTimeOut;
end
else
begin
AReplyStatus.BytesReceived := 0;
AReplyStatus.FromIpAddress := '::0';
AReplyStatus.ToIpAddress := '::0';
AReplyStatus.MsgType := 0;
AReplyStatus.SequenceId := wSeqNo;
AReplyStatus.TimeToLive := 0;
AReplyStatus.ReplyStatusType := rsTimeOut;
end;
result := true;
end else begin
AReplyStatus.ReplyStatusType := rsError;
{$IFNDEF DOTNET}
if Self.IPVersion = Id_IPv4 then
begin
Result := DecodeIPv4Packet(BytesRead,AReplyStatus);
end
else
begin
Result := DecodeIPv6Packet(BytesRead,AReplyStatus);
end;
{$ELSE}
Result := DecodeIPv4Packet(BytesRead,AReplyStatus);
{$ENDIF}
end;
end;
procedure TIdCustomIcmpClient.GetEchoReply;
begin
FReplyStatus := Receive(FReceiveTimeout);
end;
function TIdCustomIcmpClient.Receive(ATimeOut: Integer): TReplyStatus;
var
BytesRead : Integer;
begin
Result := Self.FReplyStatus;
FillBytes(FbufReceive, sizeOf(FbufReceive),0);
FStartTime := Ticks;
repeat
BytesRead := ReceiveBuffer(FbufReceive, ATimeOut);
if DecodeResponse(BytesRead, Result) then
begin
break
end
else
begin
FReplyStatus.MsRoundTripTime := Ticks - FStartTime;
FReplyStatus.Msg := RSICMPTimeout;
// We caught a response that wasn't meant for this thread - so we must
// make sure we don't report it as such in case we time out after this
if Self.IPVersion = Id_IPv4 then
begin
FReplyStatus.BytesReceived := 0;
FReplyStatus.FromIpAddress := '0.0.0.0';
FReplyStatus.ToIpAddress := '0.0.0.0';
FReplyStatus.MsgType := 0;
FReplyStatus.SequenceId := wSeqNo;
FReplyStatus.TimeToLive := 0;
FReplyStatus.ReplyStatusType := rsTimeOut;
end
else
begin
FReplyStatus.BytesReceived := 0;
FReplyStatus.FromIpAddress := '::0';
FReplyStatus.ToIpAddress := '::0';
FReplyStatus.MsgType := 0;
FReplyStatus.SequenceId := wSeqNo;
FReplyStatus.TimeToLive := 0;
FReplyStatus.ReplyStatusType := rsTimeOut;
end;
end;
until ATimeOut <= 0;
end;
procedure TIdCustomIcmpClient.DoReply(const AReplyStatus: TReplyStatus);
begin
if Assigned(FOnReply) then begin
FOnReply(Self, AReplyStatus);
end;
end;
procedure TIdCustomIcmpClient.InitComponent;
begin
inherited InitComponent;
FReplyStatus:= TReplyStatus.Create;
FProtocol := Id_IPPROTO_ICMP;
{$IFNDEF DOTNET}
ProtocolIPv6 := Id_IPPROTO_ICMPv6;
{$ENDIF}
wSeqNo := 3489; // SG 25/1/02: Arbitrary Constant <> 0
FReceiveTimeOut := Id_TIDICMP_ReceiveTimeout;
PacketSize := MAX_PACKET_SIZE;
end;
destructor TIdCustomIcmpClient.Destroy;
begin
Sys.FreeAndNil(FReplyStatus);
inherited Destroy;
end;
function TIdCustomIcmpClient.DecodeIPv4Packet(BytesRead: Cardinal;
var AReplyStatus: TReplyStatus): boolean;
var LIPHeaderLen:Cardinal;
RTTime: Cardinal;
LActualSeqID: word;
LIdx : Integer;
LIPv4 : TIdIPHdr;
LIcmp : TIdICMPHdr;
begin
Result := False;
LIdx := 0;
LIPv4 := TIdIPHdr.Create;
LIcmp := TIdICMPHdr.Create;
try
LIpHeaderLen := (FBufReceive[0] and $0F) * 4;
if (BytesRead < LIpHeaderLen + ICMP_MIN) then begin
raise EIdIcmpException.Create(RSICMPNotEnoughtBytes);
end;
LIPv4.ReadStruct(FBufReceive, LIdx);
LIdx := LIpHeaderLen;
{$IFDEF LINUX}
// TODO: baffled as to why linux kernel sends back echo from localhost
{$ENDIF}
case FBufReceive[LIpHeaderLen] of
Id_ICMP_ECHOREPLY, Id_ICMP_ECHO:
begin
AReplyStatus.ReplyStatusType := rsEcho;
// SizeOf(picmp^)
FReplydata := BytesToString(FBufReceive,LIpHeaderLen + 8, Length(FbufReceive));
//Copy(FbufReceive, iIpHeaderLen + SizeOf(picmp^) + 1, Length(FbufReceive));
// result is only valid if the seq. number is correct
end;
Id_ICMP_UNREACH:
AReplyStatus.ReplyStatusType := rsErrorUnreachable;
Id_ICMP_TIMXCEED:
AReplyStatus.ReplyStatusType := rsErrorTTLExceeded;
Id_ICMP_PARAMPROB :
AReplyStatus.ReplyStatusType := rsErrorParameter;
Id_ICMP_REDIRECT :
AReplyStatus.ReplyStatusType := rsRedirect;
Id_ICMP_TSTAMP, Id_ICMP_TSTAMPREPLY :
AReplyStatus.ReplyStatusType := rsTimeStamp;
Id_ICMP_IREQ, Id_ICMP_IREQREPLY :
AReplyStatus.ReplyStatusType := rsInfoRequest;
Id_ICMP_MASKREQ, Id_ICMP_MASKREPLY :
AReplyStatus.ReplyStatusType := rsAddressMaskRequest;
Id_ICMP_TRACEROUTE :
AReplyStatus.ReplyStatusType := rsTraceRoute;
Id_ICMP_DATAGRAM_CONV :
AReplyStatus.ReplyStatusType := rsErrorDatagramConversion;
Id_ICMP_MOB_HOST_REDIR :
AReplyStatus.ReplyStatusType := rsMobileHostRedir;
Id_ICMP_IPv6_WHERE_ARE_YOU :
AReplyStatus.ReplyStatusType := rsIPv6WhereAreYou;
Id_ICMP_IPv6_I_AM_HERE :
AReplyStatus.ReplyStatusType := rsIPv6IAmHere;
Id_ICMP_MOB_REG_REQ, Id_ICMP_MOB_REG_REPLY :
AReplyStatus.ReplyStatusType := rsMobileHostReg;
Id_ICMP_PHOTURIS :
AReplyStatus.ReplyStatusType := rsErrorSecurityFailure;
else
raise EIdICMPException.Create(RSICMPNonEchoResponse);// RSICMPNonEchoResponse = 'Non-echo type response received'
end; // case
// check if we got a reply to the packet that was actually sent
case AReplyStatus.ReplyStatusType of //
rsEcho:
begin
LActualSeqID := BytesToWord( FBufReceive,LIpHeaderLen+6);
result := LActualSeqID = wSeqNo;//;picmp^.icmp_hun.echo.seq = wSeqNo;
RTTime := GetTickDiff( BytesToLongWord( FBufReceive,LIpHeaderLen+8),Ticks); //picmp^.icmp_dun.ts.otime;
end
else
begin
// not an echo reply: the original IP frame is contained withing the DATA section of the packet
// pOriginalIP := PIdIPHdr(@picmp^.icmp_dun.data);
LActualSeqID := BytesToWord( FBufReceive,LIpHeaderLen+6+8);//pOriginalICMP^.icmp_hun.echo.seq;
RTTime := GetTickDiff( BytesToLongWord( FBufReceive,LIpHeaderLen+8+8),Ticks); //pOriginalICMP^.icmp_dun.ts.otime;
result := LActualSeqID = wSeqNo;
// move to offset
// pOriginalICMP := Pointer(Cardinal(pOriginalIP) + (iIpHeaderLen));
// extract information from original ICMP frame
// ActualSeqID := pOriginalICMP^.icmp_hun.echo.seq;
// RTTime := Ticks - pOriginalICMP^.icmp_dun.ts.otime;
// result := pOriginalICMP^.icmp_hun.echo.seq = wSeqNo;
end;
end; // case
if result then
begin
with AReplyStatus do begin
BytesReceived := BytesRead;
FromIpAddress := IdGlobal.MakeDWordIntoIPv4Address ( GStack.NetworkToHOst( BytesToLongWord( FBufReceive,12)));
ToIpAddress := IdGlobal.MakeDWordIntoIPv4Address ( GStack.NetworkToHOst( BytesToLongWord( FBufReceive,16)));
MsgType := FBufReceive[LIpHeaderLen]; //picmp^.icmp_type;
SequenceId := LActualSeqID;
MsRoundTripTime := RTTime;
TimeToLive := FBufReceive[8];
// TimeToLive := pip^.ip_ttl;
//now process our message stuff
case AReplyStatus.FMsgType of
Id_ICMP_UNREACH:
begin
case AReplyStatus.FMsgCode of
Id_ICMP_UNREACH_NET :AReplyStatus.Msg := RSICMPNetUnreachable;
Id_ICMP_UNREACH_HOST :AReplyStatus.Msg := RSICMPHostUnreachable;
Id_ICMP_UNREACH_PROTOCOL :AReplyStatus.Msg := RSICMPProtUnreachable;
Id_ICMP_UNREACH_NEEDFRAG :AReplyStatus.Msg := RSICMPFragmentNeeded;
Id_ICMP_UNREACH_SRCFAIL :AReplyStatus.Msg := RSICMPSourceRouteFailed;
Id_ICMP_UNREACH_NET_UNKNOWN :AReplyStatus.Msg := RSICMPDestNetUnknown;
Id_ICMP_UNREACH_HOST_UNKNOWN :AReplyStatus.Msg := RSICMPDestHostUnknown;
Id_ICMP_UNREACH_ISOLATED :AReplyStatus.Msg := RSICMPSourceIsolated;
Id_ICMP_UNREACH_NET_PROHIB :AReplyStatus.Msg := RSICMPDestNetProhibitted;
Id_ICMP_UNREACH_HOST_PROHIB :AReplyStatus.Msg := RSICMPDestHostProhibitted;
Id_ICMP_UNREACH_TOSNET :AReplyStatus.Msg := RSICMPTOSNetUnreach;
Id_ICMP_UNREACH_TOSHOST :AReplyStatus.Msg := RSICMPTOSHostUnreach;
Id_ICMP_UNREACH_FILTER_PROHIB :AReplyStatus.Msg := RSICMPAdminProhibitted;
Id_ICMP_UNREACH_HOST_PRECEDENCE :AReplyStatus.Msg := RSICMPHostPrecViolation;
Id_ICMP_UNREACH_PRECEDENCE_CUTOFF :AReplyStatus.Msg := RSICMPPrecedenceCutoffInEffect;
end;
end;
Id_ICMP_TIMXCEED:
begin
case AReplyStatus.MsgCode of
0 : AReplyStatus.Msg := RSICMPTTLExceeded;
1 : AReplyStatus.Msg := RSICMPFragAsmExceeded;
end;
end;
Id_ICMP_PARAMPROB:
begin
AReplyStatus.Msg := Sys.Format(RSICMPParamError,[ReplyStatus.MsgCode]);
end;
Id_ICMP_REDIRECT :
begin
AReplyStatus.RedirectTo := MakeDWordIntoIPv4Address ( GStack.NetworkToHOst( LIcmp.icmp_hun.gateway_s_l));
case AReplyStatus.MsgCode of
0 : AReplyStatus.Msg := RSICMPRedirNet;
1 : AReplyStatus.Msg := RSICMPRedirHost;
2 : AReplyStatus.Msg := RSICMPRedirTOSNet;
3 : AReplyStatus.Msg := RSICMPRedirTOSHost;
end;
end;
Id_ICMP_SOURCEQUENCH :
begin
AReplyStatus.Msg := RSICMPSourceQuenchMsg;
end;
Id_ICMP_ECHOREPLY, Id_ICMP_ECHO :
begin
AReplyStatus.Msg := RSICMPEcho;
end;
Id_ICMP_TSTAMP, Id_ICMP_TSTAMPREPLY:
begin
AReplyStatus.Msg := RSICMPTimeStamp;
end;
Id_ICMP_IREQ, Id_ICMP_IREQREPLY :
begin
AReplyStatus.Msg := RSICMPTimeStamp;
end;
Id_ICMP_MASKREQ, Id_ICMP_MASKREPLY :
begin
AReplyStatus.Msg := RSICMPMaskRequest;
end;
Id_ICMP_TRACEROUTE :
begin
case AReplyStatus.MsgCode of
Id_ICMP_TRACEROUTE_PACKET_FORWARDED : AReplyStatus.Msg := RSICMPTracePacketForwarded;
Id_ICMP_TRACEROUTE_NO_ROUTE : AReplyStatus.Msg := RSICMPTraceNoRoute;
end;
end;
Id_ICMP_DATAGRAM_CONV :
begin
case AReplyStatus.MsgCode of
Id_ICMP_CONV_UNSPEC : AReplyStatus.Msg := RSICMPTracePacketForwarded;
Id_ICMP_CONV_DONTCONV_OPTION : AReplyStatus.Msg := RSICMPTraceNoRoute;
Id_ICMP_CONV_UNKNOWN_MAN_OPTION : AReplyStatus.Msg := RSICMPConvUnknownMandOptPresent;
Id_ICMP_CONV_UNKNWON_UNSEP_OPTION : AReplyStatus.Msg := RSICMPConvKnownUnsupportedOptionPresent;
Id_ICMP_CONV_UNSEP_TRANSPORT : AReplyStatus.Msg := RSICMPConvUnsupportedTransportProtocol;
Id_ICMP_CONV_OVERALL_LENGTH_EXCEEDED : AReplyStatus.Msg := RSICMPConvOverallLengthExceeded;
Id_ICMP_CONV_IP_HEADER_LEN_EXCEEDED : AReplyStatus.Msg := RSICMPConvIPHeaderLengthExceeded;
Id_ICMP_CONV_TRANS_PROT_255 : AReplyStatus.Msg := RSICMPConvTransportProtocol_255;
Id_ICMP_CONV_PORT_OUT_OF_RANGE : AReplyStatus.Msg := RSICMPConvPortConversionOutOfRange;
Id_ICMP_CONV_TRANS_HEADER_LEN_EXCEEDED : AReplyStatus.Msg := RSICMPConvTransportHeaderLengthExceeded;
Id_ICMP_CONV_32BIT_ROLLOVER_AND_ACK : AReplyStatus.Msg := RSICMPConv32BitRolloverMissingAndACKSet;
Id_ICMP_CONV_UNKNOWN_MAN_TRANS_OPTION: AReplyStatus.Msg := RSICMPConvUnknownMandatoryTransportOptionPresent;
end;
end;
Id_ICMP_MOB_HOST_REDIR :
AReplyStatus.Msg := RSICMPMobileHostRedirect;
Id_ICMP_IPv6_WHERE_ARE_YOU :
AReplyStatus.Msg := RSICMPIPv6WhereAreYou;
Id_ICMP_IPv6_I_AM_HERE :
AReplyStatus.Msg := RSICMPIPv6IAmHere;
Id_ICMP_MOB_REG_REQ, Id_ICMP_MOB_REG_REPLY :
AReplyStatus.Msg := RSICMPIPv6IAmHere;
Id_ICMP_SKIP :
AReplyStatus.Msg := RSICMPSKIP;
Id_ICMP_PHOTURIS :
begin
case AReplyStatus.MsgCode of
Id_ICMP_BAD_SPI : AReplyStatus.Msg := RSICMPSecBadSPI;
Id_ICMP_AUTH_FAILED : AReplyStatus.Msg := RSICMPSecAuthenticationFailed;
Id_ICMP_DECOMPRESS_FAILED : AReplyStatus.Msg := RSICMPSecDecompressionFailed;
Id_ICMP_DECRYPTION_FAILED : AReplyStatus.Msg := RSICMPSecDecryptionFailed;
Id_ICMP_NEED_AUTHENTICATION : AReplyStatus.Msg := RSICMPSecNeedAuthentication;
Id_ICMP_NEED_AUTHORIZATION : AReplyStatus.Msg := RSICMPSecNeedAuthorization;
end;
end;
end;
end;
end;
finally
Sys.FreeAndNil(LIcmp);
Sys.FreeAndNil(LIPv4);
end;
end;
procedure TIdCustomIcmpClient.PrepareEchoRequestIPv4(Buffer: String);
begin
iDataSize := DEF_PACKET_SIZE + 8;
FillBytes(FbufIcmp, iDataSize, 0);
//icmp_type
FBufIcmp[0] := Id_ICMP_ECHO;
//icmp_code := 0;
FBufIcmp[1] := 0;
//skip checksum for now
//icmp_hun.echo.id := word(CurrentProcessId);
IdGlobal.CopyTIdWord(CurrentProcessId,FBufIcmp,4);
//icmp_hun.echo.seq := wSeqNo;
IdGlobal.CopyTIdWord(wSeqNo,FBufIcmp,6);
// icmp_dun.ts.otime := Ticks; - not an official thing but for Indy internal use
IdGlobal.CopyTIdLongWord(Ticks, FBufIcmp,8);
//data
if Length(Buffer)>0 then
begin
IdGlobal.CopyTIdString(Buffer,FBufIcmp,12);
end;
//the checksum is done in a send override
end;
{$IFNDEF DOTNET}
procedure TIdCustomIcmpClient.PrepareEchoRequestIPv6(Buffer: String);
var LIPv6 : TIdicmp6_hdr;
LIdx : Integer;
begin
LIPv6 := TIdicmp6_hdr.create;
try
LIdx := 0;
LIPv6.icmp6_type := ICMP6_ECHO_REQUEST;
LIPv6.icmp6_code := 0;
LIPv6.data.icmp6_un_data16[0] := word(CurrentProcessId);
LIPv6.data.icmp6_un_data16[1] := wSeqNo;
LIPv6.icmp6_cksum := 0;
LIPv6.WriteStruct(FBufIcmp,LIdx);
IdGlobal.CopyTIdLongWord(Ticks, FBufIcmp,LIdx);
Inc(LIdx,4);
if Length(Buffer)>0 then
begin
CopyTIdString(Buffer,FBufIcmp,LIdx,Length(Buffer));
end;
finally
Sys.FreeAndNil(LIPv6);
end;
end;
function TIdCustomIcmpClient.DecodeIPv6Packet(BytesRead: Cardinal;
var AReplyStatus: TReplyStatus): boolean;
var
LIdx : Integer;
LIcmp : TIdicmp6_hdr;
RTTime : Cardinal;
LActualSeqID : Word;
begin
LIdx := 0;
LIcmp := TIdicmp6_hdr.Create;
try
//NOte that IPv6 raw headers are not being returned.
LIcmp.ReadStruct(FBufReceive,LIdx);
case LIcmp.icmp6_type of
ICMP6_ECHO_REQUEST,
ICMP6_ECHO_REPLY :
begin
AReplyStatus.ReplyStatusType := rsEcho;
end;
//group membership messages
ICMP6_MEMBERSHIP_QUERY : ;
ICMP6_MEMBERSHIP_REPORT : ;
ICMP6_MEMBERSHIP_REDUCTION :;
//errors
ICMP6_DST_UNREACH : AReplyStatus.ReplyStatusType := rsErrorUnreachable;
ICMP6_PACKET_TOO_BIG : AReplyStatus.ReplyStatusType := rsErrorPacketTooBig;
ICMP6_TIME_EXCEEDED : AReplyStatus.ReplyStatusType := rsErrorTTLExceeded;
ICMP6_PARAM_PROB : AReplyStatus.ReplyStatusType := rsErrorParameter;
else
AReplyStatus.ReplyStatusType := rsError;
end;
AReplyStatus.MsgType := LIcmp.icmp6_type; //picmp^.icmp_type;
AReplyStatus.MsgCode := LIcmp.icmp6_code;
//errors are values less than ICMP6_INFOMSG_MASK
if LIcmp.icmp6_type < ICMP6_INFOMSG_MASK then
begin
//read info from the original packet part
LIcmp.ReadStruct(FBufReceive,LIdx);
end;
LActualSeqID := LIcmp.data.icmp6_seq;
Result := LActualSeqID = wSeqNo;
RTTime := Ticks - BytesToLongWord(FBufReceive, LIdx);
if result then
begin
AReplyStatus.BytesReceived := BytesRead;
AReplyStatus.SequenceId := LActualSeqID;
AReplyStatus.MsRoundTripTime := RTTime;
// TimeToLive := FBufReceive[8];
// TimeToLive := pip^.ip_ttl;
AReplyStatus.TimeToLive := FPkt.TTL;
AReplyStatus.FromIpAddress := FPkt.SourceIP;
AReplyStatus.ToIpAddress := FPkt.DestIP;
case LIcmp.icmp6_type of
ICMP6_ECHO_REQUEST,
ICMP6_ECHO_REPLY :
AReplyStatus.Msg := RSICMPEcho;
ICMP6_TIME_EXCEEDED :
begin
case LIcmp.icmp6_code of
ICMP6_TIME_EXCEED_TRANSIT :AReplyStatus.Msg := RSICMPHopLimitExceeded;
ICMP6_TIME_EXCEED_REASSEMBLY : AReplyStatus.Msg := RSICMPFragAsmExceeded;
end;
end;
ICMP6_DST_UNREACH :
begin
case LIcmp.icmp6_code of
ICMP6_DST_UNREACH_NOROUTE :AReplyStatus.Msg := RSICMPNoRouteToDest;
ICMP6_DST_UNREACH_ADMIN : AReplyStatus.Msg := RSICMPAdminProhibitted;
ICMP6_DST_UNREACH_ADDR : AReplyStatus.Msg := RSICMPHostUnreachable;
ICMP6_DST_UNREACH_NOPORT : ReplyStatus.Msg := RSICMPProtUnreachable;
ICMP6_DST_UNREACH_SOURCE_FILTERING : ReplyStatus.Msg := RSICMPSourceFilterFailed;
ICMP6_DST_UNREACH_REJCT_DST : ReplyStatus.Msg := RSICMPRejectRoutToDest;
end;
end;
ICMP6_PACKET_TOO_BIG :
AReplyStatus.Msg := Sys.Format( RSICMPPacketTooBig, [LIcmp.data.icmp6_mtu ]);
ICMP6_PARAM_PROB :
begin
case LIcmp.icmp6_code of
ICMP6_PARAMPROB_HEADER :
ReplyStatus.Msg := Sys.Format( RSICMPParamHeader,[ LIcmp.data.icmp6_pptr ]);
ICMP6_PARAMPROB_NEXTHEADER :
ReplyStatus.Msg := Sys.Format(RSICMPParamNextHeader,[ LIcmp.data.icmp6_pptr ]);
ICMP6_PARAMPROB_OPTION :
ReplyStatus.Msg := Sys.Format(RSICMPUnrecognizedOpt,[ LIcmp.data.icmp6_pptr ]);
end;
end;
ICMP6_MEMBERSHIP_QUERY : ;
ICMP6_MEMBERSHIP_REPORT : ;
ICMP6_MEMBERSHIP_REDUCTION :;
end;
end;
finally
Sys.FreeAndNil(LIcmp);
end;
end;
{$ENDIF}
procedure TIdCustomIcmpClient.Send(const AHost: string; const APort: integer;
const ABuffer: TIdBytes);
var LBuffer : TIdBytes;
LIP : String;
begin
LBuffer := ABuffer;
LIP := GStack.ResolveHost(AHost,IPVersion);
GStack.WriteChecksum(Binding.Handle,LBuffer,2,LIP,APort,FIPVersion);
FBinding.SendTo(LIP, APort, LBuffer,IPVersion);
end;
procedure TIdCustomIcmpClient.Send(const ABuffer: TIdBytes);
var LBuffer : TIdBytes;
LIP : String;
begin
LBuffer := ABuffer;
LIP := GStack.ResolveHost(Host,IPVersion);
GStack.WriteChecksum(Binding.Handle,LBuffer,2,LIP,Port,FIPVersion);
FBinding.SendTo(LIP, Port, LBuffer,IPVersion);
end;
function TIdCustomIcmpClient.GetPacketSize: Integer;
begin
Result := FPacketSize;
end;
procedure TIdCustomIcmpClient.SetPacketSize(const AValue: Integer);
begin
FPacketSize := AValue;
end;
procedure TIdCustomIcmpClient.InternalPing(const AIP, ABuffer: String;
SequenceID: word);
begin
if SequenceID <> 0 then
begin
wSeqNo := SequenceID;
end;
SetLength(FbufIcmp,FPacketSize);
if Self.FIPVersion = Id_IPv4 then
begin
SetLength(FbufReceive,FPacketSize+Id_IP_HSIZE);
end
else
begin
SetLength(FbufReceive,FPacketSize+(Id_IPv6_HSIZE*2));
end;
PrepareEchoRequest(ABuffer);
SendEchoRequest(AIP);
GetEchoReply;
Binding.CloseSocket;
DoReply(FReplyStatus);
Inc(wSeqNo); // SG 25/1/02: Only incread sequence number when finished.
end;
procedure TIdCustomIcmpClient.SendEchoRequest(const AIP: String);
begin
Send(AIP,0,FbufIcmp);
// Send(FbufIcmp);
end;
{ TIdIcmpClient }
procedure TIdIcmpClient.Ping(const ABuffer: String; SequenceID: word);
var LIP : String;
begin
LIP := GStack.ResolveHost(Host,IPVersion);
InternalPing(LIP,ABuffer,SequenceID);
end;
end.