www.pudn.com > indy10.0.52_source.rar > IdSocks.pas
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence }
{ Team Coherence is Copyright 2002 by Quality Software Components }
{ }
{ For further information / comments, visit our WEB site at }
{ http://www.TeamCoherence.com }
{**********************************************************************}
{}
{ $Log: 11984: IdSocks.pas
{
{ Rev 1.36 11/11/2004 10:25:24 PM JPMugaas
{ Added OpenProxy and CloseProxy so you can do RecvFrom and SendTo functions
{ from the UDP client with SOCKS. You must call OpenProxy before using
{ RecvFrom or SendTo. When you are finished, you must use CloseProxy to close
{ any connection to the Proxy. Connect and disconnect also call OpenProxy and
{ CloseProxy.
}
{
{ Rev 1.35 11/11/2004 3:42:50 AM JPMugaas
{ Moved strings into RS. Socks will now raise an exception if you attempt to
{ use SOCKS4 and SOCKS4A with UDP. Those protocol versions do not support UDP
{ at all.
}
{
{ Rev 1.34 11/10/2004 10:55:58 PM JPMugaas
{ UDP Association bug fix - we now send 0's for IP address and port.
}
{
{ Rev 1.33 11/10/2004 10:38:42 PM JPMugaas
{ Bug fixes - UDP with SOCKS now works.
}
{
{ Rev 1.32 11/10/2004 9:42:54 PM JPMugaas
{ 1 in a reserved position should be 0 in a UDP request packet.
}
{
{ Rev 1.31 11/9/2004 8:18:00 PM JPMugaas
{ Attempt to add SOCKS support in UDP.
}
{
{ Rev 1.30 03/07/2004 10:08:22 CCostelloe
{ Removed spurious code that generates warning
}
{
{ Rev 1.29 6/9/04 7:44:44 PM RLebeau
{ various ReadBytes() tweaks
{
{ updated MakeSocks4Request() to call AIOHandler.WriteBufferCancel() on error.
}
{
{ Rev 1.28 2004.05.20 1:39:58 PM czhower
{ Last of the IdStream updates
}
{
{ Rev 1.27 2004.05.20 9:19:24 AM czhower
{ Removed unused var
}
{
Rev 1.26 5/19/2004 10:44:42 PM DSiders
Corrected spelling for TIdIPAddress.MakeAddressObject method.
}
{
{ Rev 1.25 5/19/2004 2:44:40 PM JPMugaas
{ Fixed compiler warnings in TIdSocksInfo.Listen.
}
{
{ Rev 1.24 5/8/2004 3:45:34 PM BGooijen
{ Listen works in Socks 4 now
}
{
{ Rev 1.23 5/7/2004 4:52:44 PM JPMugaas
{ Bind in SOCKS4 should work a bit better. There's still some other work that
{ needs to be done on it.
}
{
{ Rev 1.22 5/7/2004 8:54:54 AM JPMugaas
{ Attempt to add SOCKS4 bind.
}
{
{ Rev 1.21 5/7/2004 7:43:24 AM JPMugaas
{ Checked Bas's changes.
}
{
{ Rev 1.20 5/7/2004 5:53:20 AM JPMugaas
{ Removed some duplicate code to reduce the probability of error.
}
{
{ Rev 1.19 5/7/2004 1:44:12 AM BGooijen
{ Bind
}
{
{ Rev 1.18 5/6/2004 6:47:04 PM JPMugaas
{ Attempt to work on bind further.
}
{
{ Rev 1.16 5/6/2004 5:32:58 PM JPMugaas
{ Port was being mangled because the compiler was assuming you wanted a 4 byte
{ byte order instead of only a two byte byte order function.
{ IP addresses are better handled. At least I can connect again.
}
{
{ Rev 1.15 5/5/2004 2:09:40 PM JPMugaas
{ Attempt to reintroduce bind and listen functionality for FTP.
}
{
{ Rev 1.14 2004.03.07 11:48:44 AM czhower
{ Flushbuffer fix + other minor ones found
}
{
{ Rev 1.13 2004.02.03 4:16:52 PM czhower
{ For unit name changes.
}
{
{ Rev 1.12 2/2/2004 2:33:04 PM JPMugaas
{ Should compile better.
}
{
{ Rev 1.11 2/2/2004 12:23:16 PM JPMugaas
{ Attempt to fix the last Todo concerning IPv6.
}
{
{ Rev 1.10 2/2/2004 11:43:08 AM BGooijen
{ DotNet
}
{
{ Rev 1.9 2/2/2004 12:00:08 AM BGooijen
{ Socks 4 / 4A working again
}
{
{ Rev 1.8 2004.01.20 10:03:34 PM czhower
{ InitComponent
}
{
{ Rev 1.7 1/11/2004 10:45:56 PM BGooijen
{ Socks 5 works on D7 now, Socks 4 almost
}
{
{ Rev 1.6 2003.10.11 5:50:34 PM czhower
{ -VCL fixes for servers
{ -Chain suport for servers (Super core)
{ -Scheduler upgrades
{ -Full yarn support
}
{
{ Rev 1.5 2003.10.01 1:37:34 AM czhower
{ .Net
}
{
{ Rev 1.4 2003.09.30 7:37:28 PM czhower
{ Updates for .net
}
{
Rev 1.3 4/2/2003 3:23:00 PM BGooijen
fixed and re-enabled
}
{
{ Rev 1.2 2003.01.10 8:21:04 PM czhower
{ Removed more warnings
}
{
{ Rev 1.1 2003.01.10 7:21:14 PM czhower
{ Removed warnings
}
{
{ Rev 1.0 11/13/2002 08:58:56 AM JPMugaas
}
unit IdSocks;
interface
uses
Classes, IdAssignedNumbers, IdException,
IdComponent, IdCustomTransparentProxy, IdGlobal, IdIOHandler, IdSocketHandle;
type
EIdSocksUDPNotSupportedBySOCKSVersion = class(EIdException);
TSocksVersion = (svNoSocks, svSocks4, svSocks4A, svSocks5);
TSocksAuthentication = (saNoAuthentication, saUsernamePassword);
const
ID_SOCKS_AUTH = saNoAuthentication;
ID_SOCKS_VER = svNoSocks;
type
TIdSocksInfo = class(TIdCustomTransparentProxy)
protected
FAuthentication: TSocksAuthentication;
FVersion: TSocksVersion;
FUDPSocksAssociation : TIdIOHandler;
//
function DisasmUDPReplyPacket(const APacket : TIdBytes;
var VHost : String; var VPort : Integer): TIdBytes;
function MakeUDPRequestPacket(const AData: TIdBytes;
const AHost : String; const APort : Integer) : TIdBytes;
procedure AssignTo(ASource: TPersistent); override;
function GetEnabled: Boolean; override;
procedure InitComponent; override;
procedure AuthenticateSocks5Connection(AIOHandler: TIdIOHandler);
// This must be defined with an port value that's a word so that we use the 2 byte Network Order byte functions instead
// the 4 byte or 8 byte functions. If we use the wrong byte order functions, we can get a zero port value causing an error.
procedure MakeSocks4Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte);
procedure MakeSocks5Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte; var VBuf : TIdBytes; var VLen : Integer);
procedure MakeSocks4Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
procedure MakeSocks4Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
procedure MakeSocks5Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
procedure MakeSocks5Bind(AIOHandler: TIdIOHandler; const AHost: string;
const APort: Integer);
procedure MakeConnection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer); override;
function MakeSocks4Listen(AIOHandler: TIdIOHandler; const ATimeOut:integer):boolean;
function MakeSocks5Listen(AIOHandler: TIdIOHandler; const ATimeOut:integer):boolean;
//association for UDP
procedure MakeSocks5UDPAssociation(AHandle : TIdSocketHandle);
procedure CloseSocks5UDPAssociation;
public
procedure Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer); override;
function Listen(AIOHandler: TIdIOHandler; const ATimeOut:integer):boolean;override;
procedure OpenUDP(AHandle : TIdSocketHandle; const AHost: string=''; const APort: Integer=0); override;
function RecvFromUDP(AHandle: TIdSocketHandle;
var ABuffer : TIdBytes;
var VPeerIP: string; var VPeerPort: integer;
AMSec: Integer = IdTimeoutDefault): integer; override;
procedure SendToUDP(AHandle: TIdSocketHandle;
AHost: string; const APort: Integer; const ABuffer : TIdBytes); override;
procedure CloseUDP(AHandle: TIdSocketHandle); override;
published
property Authentication: TSocksAuthentication read FAuthentication write FAuthentication default ID_SOCKS_AUTH;
property Host;
property Password;
property Port default IdPORT_SOCKS;
property Username;
property Version: TSocksVersion read FVersion write FVersion default ID_SOCKS_VER;
property ChainedProxy;
End;//TIdSocksInfo
implementation
uses
IdIOHandlerSocket,
IdResourceStringsCore, IdExceptionCore, IdIPAddress, IdStack,
IdTCPClient,
IdIOHandlerStack,
SysUtils;
{ TIdSocksInfo }
procedure TIdSocksInfo.AssignTo(ASource: TPersistent);
begin
if ASource is TIdSocksInfo then begin
inherited AssignTo(ASource);
with TIdSocksInfo(ASource) do begin
Authentication := Self.Authentication;
Version := Self.Version;
end;
end else begin
inherited AssignTo(ASource);
end;
end;
procedure TIdSocksInfo.MakeSocks4Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte);
var
LIpAddr: String;
LTempPort : Word;
begin
AIOHandler.WriteBufferOpen;
try
AIOHandler.Write(ToBytes(Byte(4))); // Version
AIOHandler.Write(ToBytes(ARequest)); // Opcode
LTempPort := GStack.HostToNetwork(APort);
AIOHandler.Write(ToBytes(LTempPort)); // Port
if Version = svSocks4A then begin
LIpAddr := '0.0.0.1'; {Do not Localize}
end else begin
LIpAddr := GStack.ResolveHost(AHost,Id_IPv4);
end;
AIOHandler.Write(ToBytes(Byte(StrToInt(Fetch(LIpAddr,'.')))));// IP
AIOHandler.Write(ToBytes(Byte(StrToInt(Fetch(LIpAddr,'.')))));// IP
AIOHandler.Write(ToBytes(Byte(StrToInt(Fetch(LIpAddr,'.')))));// IP
AIOHandler.Write(ToBytes(Byte(StrToInt(Fetch(LIpAddr,'.')))));// IP
AIOHandler.Write(ToBytes(Username));
AIOHandler.Write(ToBytes(Byte(0)));// Username
if Version = svSocks4A then begin
AIOHandler.Write(ToBytes(AHost));
AIOHandler.Write(ToBytes(Byte(0)));// Host
end;
AIOHandler.WriteBufferClose; //flush everything
except
AIOHandler.WriteBufferCancel; //cancel everything
raise;
end;
end;
procedure TIdSocksInfo.MakeSocks4Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
var
LResponse: TIdBytes;
begin
MakeSocks4Request(AIOHandler, AHost, APort,$01); //connect
AIOHandler.ReadBytes(LResponse, 8, False);
case LResponse[1] of // OpCode
90: ;// request granted, do nothing
91: raise EIdSocksRequestFailed.Create(RSSocksRequestFailed);
92: raise EIdSocksRequestServerFailed.Create(RSSocksRequestServerFailed);
93: raise EIdSocksRequestIdentFailed.Create(RSSocksRequestIdentFailed);
else raise EIdSocksUnknownError.Create(RSSocksUnknownError);
end;
end;
procedure TIdSocksInfo.MakeSocks5Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte; var VBuf : TIdBytes; var VLen : Integer);
var LtempPort : Word;
LIP : TIdIPAddress;
begin
// Connection process
VBuf[0] := $5; // socks version
VBuf[1] := ARequest; //request method
VBuf[2] := $0; // reserved
if (length(MakeCanonicalIPv6Address(AHost))>0) then begin
VBuf[3] := $4; // address type: IP V4 address: X'01' {Do not Localize}
// DOMAINNAME: X'03' {Do not Localize}
// IP V6 address: X'04' {Do not Localize}
VBuf[4] :=16; // 16 bytes for the ip
VLen := 5;
LIP := TIdIPAddress.MakeAddressObject(AHost);
try
if Assigned(LIP) then
begin
CopyTIdBytes(LIP.HToNBytes,0,VBuf,4,16);
end;
finally
FreeAndNil(LIP);
end;
VLen := VLen + 16;
end
else
begin
// for now we stick with domain name, must ask Chad how to detect
// address type
if GStack.IsIP( AHost ) then
begin
VBuf[3] := $01; //IPv4 address
LIP := TIdIPAddress.MakeAddressObject(AHost);
try
if Assigned(LIP) then
begin
CopyTIdBytes(LIP.HToNBytes,0,VBuf,4,4);
end;
finally
FreeAndNil(LIP);
end;
VLen := 8;
end
else
begin
VBuf[3] := $3; // address type: IP V4 address: X'01' {Do not Localize}
// DOMAINNAME: X'03' {Do not Localize}
// IP V6 address: X'04' {Do not Localize}
// host name
VBuf[4] := Length(AHost);
VLen := 5;
if Length(AHost) > 0 then begin
CopyTIdBytes(ToBytes(AHost),0,VBuf,VLen,Length(AHost));
end;
VLen := VLen + Length(AHost);
end;
end;
// port
LtempPort := GStack.HostToNetwork(APort);
CopyTIdBytes(ToBytes(LtempPort),0,VBuf,VLen,2);
VLen := VLen + 2;
end;
procedure TIdSocksInfo.MakeSocks5Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
var
pos: Integer;
LBuf: TIdBytes;
begin
AuthenticateSocks5Connection(AIOHandler);
SetLength(LBuf, 255);
MakeSocks5Request(AIOHandler, AHost, APort, $01, LBuf, Pos);
AIOHandler.WriteDirect(ToBytes(LBuf, pos)); // send the connection packet
try
AIOHandler.ReadBytes(LBuf, 5, False); // Socks server replies on connect, this is the first part
except
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
case LBuf[1] of
0: ;// success, do nothing
1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
else
raise EIdSocksUnknownError.Create(RSSocksUnknownError);
end;
// type of destination address is domain name
case LBuf[3] of
// IP V4
1: pos := 4 + 2; // 4 is for address and 2 is for port length
// FQDN
3: pos := LBuf[4] + 2; // 2 is for port length
// IP V6
4: pos := 16 + 2; // 16 is for address and 2 is for port length
end;
try
// Socks server replies on connect, this is the second part
// RLebeau: why -1?
AIOHandler.ReadBytes(LBuf, pos-1, False); // just write it over the first part for now
except
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
end;
procedure TIdSocksInfo.MakeSocks4Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
var
LResponse: TIdBytes;
LClient: TIdTcpClient;
begin
LClient := TIdTCPClient.Create(nil);
try
// SetLength(LResponse, 255);
SetLength(LResponse, 8);
TIdIOHandlerSocket(AIOHandler).TransparentProxy := nil;
LClient.IOHandler := AIOHandler;
LClient.Host := Host;
LClient.Port := Port;
LClient.Connect;
TIdIOHandlerSocket(AIOHandler).TransparentProxy := Self;
MakeSocks4Request(AIOHandler, AHost, APort, $02); //bind
AIOHandler.ReadBytes(LResponse, 2, False);
case LResponse[1] of // OpCode
90: ;// request granted, do nothing
91: raise EIdSocksRequestFailed.Create(RSSocksRequestFailed);
92: raise EIdSocksRequestServerFailed.Create(RSSocksRequestServerFailed);
93: raise EIdSocksRequestIdentFailed.Create(RSSocksRequestIdentFailed);
else raise EIdSocksUnknownError.Create(RSSocksUnknownError);
end;
try
// Socks server replies on connect, this is the second part
AIOHandler.ReadBytes(LResponse, 6, False); //overwrite the first part for now
TIdIOHandlerSocket(AIOHandler).Binding.SetBinding( IntToStr(LResponse[2])+'.'+IntToStr(LResponse[3])+'.'+IntToStr(LResponse[4])+'.'+IntToStr(LResponse[5]) , LResponse[0]*256+LResponse[1]);
except
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
finally
LClient.IOHandler := nil;
FreeAndNil(LClient);
end;
end;
procedure TIdSocksInfo.MakeConnection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
begin
case Version of
svSocks4, svSocks4A: MakeSocks4Connection(AIOHandler, AHost, APort);
svSocks5: MakeSocks5Connection(AIOHandler, AHost, APort);
end;
end;
function TIdSocksInfo.GetEnabled: Boolean;
Begin
Result := Version in [svSocks4, svSocks4A, svSocks5];
End;//
procedure TIdSocksInfo.InitComponent;
begin
inherited;
Authentication := ID_SOCKS_AUTH;
Version := ID_SOCKS_VER;
Port := IdPORT_SOCKS;
FUDPSocksAssociation := TIdIOHandlerStack.Create;
end;
procedure TIdSocksInfo.AuthenticateSocks5Connection(
AIOHandler: TIdIOHandler);
var
pos: Integer;
LBuf: TIdBytes;
LRequestedAuthMethod,
LServerAuthMethod,
LUsernameLen,
LPasswordLen : Byte;
begin
SetLength(LBuf, 3);
// defined in rfc 1928
if Authentication = saNoAuthentication then begin
LBuf[2] := $0 // No authentication
end else begin
LBuf[2] := $2; // Username password authentication
end;
LRequestedAuthMethod := LBuf[2];
LBuf[0] := $5; // socks version
LBuf[1] := $1; // number of possible authentication methods
AIOHandler.WriteDirect(LBuf);
try
AIOHandler.ReadBytes(LBuf, 2, False); // Socks server sends the selected authentication method
except
On E: Exception do begin
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
end;
LServerAuthMethod := LBuf[1];
if (LServerAuthMethod <> LRequestedAuthMethod) or (LServerAuthMethod = $FF) then begin
raise EIdSocksAuthMethodError.Create(RSSocksAuthMethodError);
end;
// Authentication process
if Authentication = saUsernamePassword then begin
LUsernameLen := Length(Username);
LPasswordLen := Length(Password);
SetLength(LBuf, 3 + LUsernameLen + LPasswordLen);
LBuf[0] := 1; // version of subnegotiation
LBuf[1] := LUsernameLen;
pos := 2;
if LUsernameLen > 0 then begin
CopyTIdBytes(ToBytes(Username), 0, LBuf, pos, LUsernameLen);
pos := pos + LUsernameLen;
end;
LBuf[pos] := LPasswordLen;
pos := pos + 1;
if LPasswordLen > 0 then begin
CopyTIdBytes(ToBytes(Password), 0, LBuf, pos, LPasswordLen);
end;
AIOHandler.WriteDirect(LBuf); // send the username and password
try
AIOHandler.ReadBytes(LBuf, 2, False); // Socks server sends the authentication status
except
On E: Exception do begin
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
end;
if LBuf[1] <> $0 then begin
raise EIdSocksAuthError.Create(RSSocksAuthError);
end;
end;
end;
procedure TIdSocksInfo.MakeSocks5Bind(AIOHandler: TIdIOHandler; const AHost: string;
const APort: Integer);
var
Lpos: Integer;
LBuf: TIdBytes;
LClient:TIdTcpClient;
begin
LClient := TIdTCPClient.Create(nil);
try
SetLength(LBuf, 255);
TIdIOHandlerSocket(AIOHandler).TransparentProxy := nil;
LClient.IOHandler := AIOHandler;
LClient.Host := Host;
LClient.Port := Port;
LClient.Connect;
TIdIOHandlerSocket(AIOHandler).TransparentProxy := Self;
AuthenticateSocks5Connection(AIOHandler);
// Bind process
MakeSocks5Request(AIOHandler, AHost, APort, $02, LBuf, LPos); //bind request
//
AIOHandler.Write(ToBytes(LBuf, LPos)); // send the connection packet
try
AIOHandler.ReadBytes(LBuf, 4, False); // Socks server replies on connect, this is the first part
except
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
case LBuf[1] of
0: ;// success, do nothing
1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
else
raise EIdSocksUnknownError.Create(RSSocksUnknownError);
end;
// type of destination address is domain name
case LBuf[3] of
// IP V4
1: Lpos := 4 + 2; // 4 is for address and 2 is for port length
// FQDN
3: Lpos := LBuf[4] + 2; // 2 is for port length
// IP V6
4: LPos := 16 + 2; // 16 is for address and 2 is for port length
end;
try
// Socks server replies on connect, this is the second part
AIOHandler.ReadBytes(LBuf, Lpos, False); //overwrite the first part for now
TIdIOHandlerSocket(AIOHandler).binding.SetBinding( IntToStr(LBuf[0])+'.'+IntToStr(LBuf[1])+'.'+IntToStr(LBuf[2])+'.'+IntToStr(LBuf[3]) ,LBuf[4]*256+LBuf[5]);
except
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
finally
LClient.IOHandler := nil;
FreeAndNil(LClient);
end;
end;
procedure TIdSocksInfo.Bind(AIOHandler: TIdIOHandler; const AHost: string;
const APort: Integer);
begin
case Version of
svSocks4, svSocks4A: MakeSocks4Bind(AIOHandler, AHost, APort);
svSocks5: MakeSocks5Bind(AIOHandler, AHost, APort);
end;
end;
function TIdSocksInfo.Listen(AIOHandler: TIdIOHandler;
const ATimeOut: integer): boolean;
begin
Result := False;
case Version of
svSocks4, svSocks4A: Result := MakeSocks4Listen(AIOHandler, ATimeOut);
svSocks5: Result := MakeSocks5Listen(AIOHandler, ATimeOut);
end;
end;
function TIdSocksInfo.MakeSocks5Listen(AIOHandler: TIdIOHandler;
const ATimeOut: integer): boolean;
var
Lpos: Integer;
LBuf: TIdBytes;
begin
SetLength(LBuf, 255);
Result := TIdIOHandlerSocket(AIOHandler).Binding.Readable(ATimeOut);
if Result then begin
AIOHandler.ReadBytes(LBuf, 4, False); // Socks server replies on connect, this is the first part
case LBuf[1] of
0: ;// success, do nothing
1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
else
raise EIdSocksUnknownError.Create(RSSocksUnknownError);
end;
// type of destination address is domain name
case LBuf[3] of
// IP V4
1: Lpos := 4 + 2; // 4 is for address and 2 is for port length
// FQDN
3: Lpos := LBuf[4] + 2; // 2 is for port length
// IP V6 - 4:
else
Lpos := 16 + 2; // 16 is for address and 2 is for port length
end;
// Socks server replies on connect, this is the second part
AIOHandler.ReadBytes(LBuf, Lpos, False); // just write it over the first part for now
TIdIOHandlerSocket(AIOHandler).Binding.SetPeer(IntToStr(LBuf[0])+'.'+IntToStr(LBuf[1])+'.'+IntToStr(LBuf[2])+'.'+IntToStr(LBuf[3]),LBuf[4]*256+LBuf[5]);
end;
end;
function TIdSocksInfo.MakeSocks4Listen(AIOHandler: TIdIOHandler;
const ATimeOut: integer): boolean;
var
LBuf: TIdBytes;
begin
SetLength(LBuf, 6);
Result := TIdIOHandlerSocket(AIOHandler).Binding.Readable(ATimeOut);
if Result then begin
AIOHandler.ReadBytes(LBuf, 2, False); // Socks server replies on connect, this is the first part
case LBuf[1] of // OpCode
90: ;// request granted, do nothing
91: raise EIdSocksRequestFailed.Create(RSSocksRequestFailed);
92: raise EIdSocksRequestServerFailed.Create(RSSocksRequestServerFailed);
93: raise EIdSocksRequestIdentFailed.Create(RSSocksRequestIdentFailed);
else raise EIdSocksUnknownError.Create(RSSocksUnknownError);
end;
// Socks server replies on connect, this is the second part
AIOHandler.ReadBytes(LBuf, 6, False); // just write it over the first part for now
TIdIOHandlerSocket(AIOHandler).Binding.SetPeer(IntToStr(LBuf[2])+'.'+IntToStr(LBuf[3])+'.'+IntToStr(LBuf[4])+'.'+IntToStr(LBuf[5]) , LBuf[0]*256+LBuf[1]);
end;
end;
procedure TIdSocksInfo.CloseSocks5UDPAssociation;
begin
if Assigned(FUDPSocksAssociation) then
begin
FUDPSocksAssociation.Close;
end;
end;
procedure TIdSocksInfo.MakeSocks5UDPAssociation(AHandle: TIdSocketHandle);
var
Lpos: Integer;
LBuf: TIdBytes;
begin
FUDPSocksAssociation.Host := Self.Host;
FUDPSocksAssociation.Port := Self.Port;
FUDPSocksAssociation.Open;
try
SetLength(LBuf, 255);
AuthenticateSocks5Connection(FUDPSocksAssociation);
// Associate process
//For SOCKS5 Associate, the IP address and port is the client's IP address and port which may
//not be known
if AHandle.IPVersion = IdGlobal.Id_IPv4 then
begin
MakeSocks5Request(FUDPSocksAssociation, '0.0.0.0', 0, $03, LBuf, LPos); //associate request
end
else
begin
MakeSocks5Request(FUDPSocksAssociation, '::0', 0, $03, LBuf, LPos); //associate request
end;
//
FUDPSocksAssociation.Write(ToBytes(LBuf, LPos)); // send the connection packet
try
FUDPSocksAssociation.ReadBytes(LBuf, 2, False); // Socks server replies on connect, this is the first part )VER and RSP
except
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
case LBuf[1] of
0: ;// success, do nothing
1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
else
raise EIdSocksUnknownError.Create(RSSocksUnknownError);
end;
FUDPSocksAssociation.ReadBytes(LBuf, 2, False); //Now get RSVD and ATYPE feilds
// type of destination address is domain name
case LBuf[1] of
// IP V4
1: Lpos := 4 + 2; // 4 is for address and 2 is for port length
// FQDN
3: Lpos := LBuf[4] + 2; // 2 is for port length
// IP V6
4: LPos := 16 + 2; // 16 is for address and 2 is for port length
end;
try
// Socks server replies on connect, this is the second part
FUDPSocksAssociation.ReadBytes(LBuf, Lpos, False); //overwrite the first part for now
AHandle.SetPeer( (FUDPSocksAssociation as TIdIOHandlerStack).Binding.PeerIP ,LBuf[4]*256+LBuf[5]); //IntToStr(LBuf[0])+'.'+IntToStr(LBuf[1])+'.'+IntToStr(LBuf[2])+'.'+IntToStr(LBuf[3])
AHandle.Connect;
except
raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
end;
except
on E: Exception do
begin
FUDPSocksAssociation.Close;
raise;
end;
end;
end;
procedure TIdSocksInfo.CloseUDP(AHandle: TIdSocketHandle);
begin
case Version of
svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
svSocks5: CloseSocks5UDPAssociation;
end;
end;
procedure TIdSocksInfo.OpenUDP(AHandle: TIdSocketHandle;
const AHost: string=''; const APort: Integer=0);
begin
case Version of
svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
svSocks5: MakeSocks5UDPAssociation(AHandle);
end;
end;
function TIdSocksInfo.DisasmUDPReplyPacket(const APacket : TIdBytes;
var VHost : String; var VPort : Integer): TIdBytes;
{
+----+------+------+----------+----------+----------+
|RSV | FRAG | ATYP | DST.ADDR | DST.PORT | DATA |
+----+------+------+----------+----------+----------+
| 2 | 1 | 1 | Variable | 2 | Variable |
+----+------+------+----------+----------+----------+
01 2 3
The fields in the UDP request header are:
o RSV Reserved X'0000'
o FRAG Current fragment number
o ATYP address type of following addresses:
o IP V4 address: X'01'
o DOMAINNAME: X'03'
o IP V6 address: X'04'
o DST.ADDR desired destination address
o DST.PORT desired destination port
o DATA user data
}
var LLen : Integer;
// LIP : TIdIPAddress;
LIP6 : TIdIPv6Address;
LtempPort : Word;
LHost : TIdBytes;
i : Integer;
begin
if Length(APacket)<5 then
begin
Exit;
end;
// type of destination address is domain name
case APacket[3] of
// IP V4
1: begin
LLen := 4 + 4; //4 IPv4 address len, 4- 2 reserved, 1 frag, 1 atype
VHost := IntToStr(APacket[4])+'.'+IntToStr(APacket[5])+'.'+IntToStr(APacket[6])+'.'+IntToStr(APacket[7]);
end;
// FQDN
3: begin
LLen := APacket[4] +4; // 2 is for port length, 4 - 2 reserved, 1 frag, 1 atype
if Length(APacket)< (5+LLen) then
begin
Exit;
end;
SetLength(LHost,APacket[4]);
CopyTIdBytes(APacket,5,LHost,0,APacket[4]);
VHost := BytesToString(LHost);
end;
// IP V6 - 4:
else
LLen := 16 + 4; // 16 is for address, 2 is for port length,4 - 2 reserved, 1 frag, 1 atype
SetLength(LHost,16);
CopyTIdBytes(APacket,5,LHost,0,16);
LIP6 := BytesToIPv6(LHost);
for i := 0 to 7 do
begin
LIP6[i] := GStack.NetworkToHost(LIP6[i]);
end;
VHost := IPv6AddressToStr(LIP6);
end;
LtempPort := APacket[LLen]*256+ APacket[LLen+1];
VPort := LtempPort;
LLen := LLen + 2;
SetLength(Result,Length(APacket)-LLen);
CopyTIdBytes(APacket,LLen,Result,0,Length(APacket)-LLen);
end;
function TIdSocksInfo.MakeUDPRequestPacket(const AData: TIdBytes;
const AHost : String; const APort : Integer) : TIdBytes;
{
+----+------+------+----------+----------+----------+
|RSV | FRAG | ATYP | DST.ADDR | DST.PORT | DATA |
+----+------+------+----------+----------+----------+
| 2 | 1 | 1 | Variable | 2 | Variable |
+----+------+------+----------+----------+----------+
01 2 3
The fields in the UDP request header are:
o RSV Reserved X'0000'
o FRAG Current fragment number
o ATYP address type of following addresses:
o IP V4 address: X'01'
o DOMAINNAME: X'03'
o IP V6 address: X'04'
o DST.ADDR desired destination address
o DST.PORT desired destination port
o DATA user data
}
var LLen : Integer;
LIP : TIdIPAddress;
LtempPort : Word;
begin
SetLength(Result,1024);
Result[0] := 0;
Result[1] := 0;
Result[2] := 0; //no fragmentation - too lazy to implement it
if (length(MakeCanonicalIPv6Address(AHost))>0) then begin
Result[3] := $4; // address type: IP V4 address: X'01' {Do not Localize}
// DOMAINNAME: X'03' {Do not Localize}
// IP V6 address: X'04' {Do not Localize}
Result[4] :=16; // 16 bytes for the ip
LLen := 5;
LIP := TIdIPAddress.MakeAddressObject(AHost);
try
if Assigned(LIP) then
begin
CopyTIdBytes(LIP.HToNBytes,0,Result,4,16);
end;
finally
FreeAndNil(LIP);
end;
LLen := LLen + 16;
end
else
begin
// for now we stick with domain name, must ask Chad how to detect
// address type
if GStack.IsIP( AHost ) then
begin
Result[3] := $01; //IPv4 address
Result[4] :=4; // 4 bytes for the ip
LIP := TIdIPAddress.MakeAddressObject(AHost);
try
if Assigned(LIP) then
begin
CopyTIdBytes(LIP.HToNBytes,0,Result,4,4);
end;
finally
FreeAndNil(LIP);
end;
LLen := 8;
end
else
begin
Result[3] := $3; // address type: IP V4 address: X'01' {Do not Localize}
// DOMAINNAME: X'03' {Do not Localize}
// IP V6 address: X'04' {Do not Localize}
// host name
Result[4] := Length(AHost);
LLen := 5;
if Length(AHost) > 0 then begin
CopyTIdBytes(ToBytes(AHost),0,Result,LLen,Length(AHost));
end;
LLen := LLen + Length(AHost);
end;
end;
// port
LtempPort := APort; //done this way to avoid a range check error
LtempPort := GStack.HostToNetwork(LtempPort);
CopyTIdBytes(ToBytes(LtempPort),0,Result,LLen,2);
LLen := LLen + 2;
//now do the rest of the packet
SetLength(Result,LLen + Length(AData));
CopyTIdBytes(AData,0,Result,LLen,Length(AData));
end;
function TIdSocksInfo.RecvFromUDP(AHandle: TIdSocketHandle;
var ABuffer : TIdBytes;
var VPeerIP: string; var VPeerPort: integer;
AMSec: Integer = IdTimeoutDefault): integer;
var LBuf : TIdBytes;
begin
case Version of
svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
end;
SetLength(LBuf,Length(ABuffer)+200);
if not AHandle.Readable(AMSec) then begin
Result := 0;
VPeerIP := ''; {Do not Localize}
VPeerPort := 0;
Exit;
end;
Result := AHandle.RecvFrom(LBuf,VPeerIP, VPeerPort);
SetLength(LBuf,Result);
LBuf := DisasmUDPReplyPacket(LBuf, VPeerIP, VPeerPort);
Result := Length(LBuf);
IdGlobal.CopyTIdBytes(LBuf,0,ABuffer,0,Result);
end;
procedure TIdSocksInfo.SendToUDP(AHandle: TIdSocketHandle;
AHost: string; const APort: Integer; const ABuffer : TIdBytes);
var LBuf : TIdBytes;
begin
case Version of
svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
end;
LBuf := MakeUDPRequestPacket(ABuffer, AHost,APort);
AHandle.Send(LBuf,0);
end;
end.