Код:
program socks5srv;
{$APPTYPE CONSOLE}
uses windows, winsock,sysutils;
//длина очереди
const NLISTEN=5;
//Максимальная длина принятой строки
const MAX_RECV_BUF_SIZE=1500;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Структура с информацией о клиенте
type CLIENT_INFO = record
sock:TSocket;
TargetSock:TSocket;
ClientAddr:TInAddr;
ServerAddr:TInAddr;
TargetConnected:boolean;
ClientConnected:boolean;
end;
PCLIENT_INFO=^CLIENT_INFO;
var CRLF:array[0..1] of char=(#13,#10);
//Импортируемые функции
function send(s: TSocket; Buf:pChar; len, flags: Integer): Integer;
stdcall; external 'ws2_32.dll';
function recv(s: TSocket; Buf:pChar; len, flags: Integer): Integer;
stdcall; external 'ws2_32.dll';
function AcceptEx(
sListenSocket,
sAcceptSocket:TSocket;
lpOutputBuffer:pointer;
dwReceiveDataLength,
dwLocalAddressLength,
dwRemoteAddressLength:DWORD;
lpdwBytesReceived:LPDWORD;
lpOverlapped:POVERLAPPED
):boolean;
stdcall; external 'Mswsock.dll';
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
var MainSock:TSocket;
var Listened:boolean=true;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure error(str:string);
begin
writeln(str);
halt(0);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Вызывается при закрытии консоли
procedure ConsoleEvent(dwCtrlType:cardinal);
begin
Listened:=false;
closesocket(MainSock);
Sleep(dword(-1));
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function GetTime:ansistring;
var Time:SYSTEMTIME;
s:ansistring;
begin
GetLocalTime(Time);
s:='{'+
IntToStr(Time.wYear)+'.'+
IntToStr(Time.wMonth)+'.'+
IntToStr(Time.wDay)+' '+
IntToStr(Time.wHour)+'.'+
IntToStr(Time.wMinute)+'.'+
IntToStr(Time.wSecond)+'} ';
result:=s;
end;
{#################################################################}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure Shut(info:PCLIENT_INFO);
begin
if info.sock<>0 then begin
shutdown(info.sock,SD_BOTH);
closesocket(info.sock);
info.sock:=0;
end;
ExitThread(0);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function dns(Host:pChar):TInAddr;
type TaPInAddr = array [0..10] of PinAddr;
PaPInAddr = ^TaPInAddr;
var phe:pHostEnt;
pptr: PaPInAddr;
begin
phe:=gethostbyname(Host);
zeromemory(@result,sizeof(result));
if phe <> nil then begin;
pPtr := PaPInAddr(phe^.h_addr_list);
if pPtr^[0] <> nil then result:=pptr^[0]^;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure RecvBuffer(info:PCLIENT_INFO; var Buf; dwSize:integer);
type ByteBuf=array[0..144000] of byte;
var len,k,r:integer;
begin
len:=0;
repeat
k:=dwSize-len;
r:=recv(info.sock,@ByteBuf(Buf)[len],k,0);
if r<=0 then begin
writeln(' !Error! Connection closed by client');
shut(info);
end;
len:=len+r;
until len=dwSize;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure SendBuffer(sock:integer; pBuf:pchar; dwSize:integer);
begin
send(sock,pBuf,dwSize,0);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure ClientToTarget(info:PCLIENT_INFO);stdcall;
var k:integer;
buf:array[0..1499] of byte;
begin
while true do begin
zeromemory(@buf,sizeof(buf));
k:=recv(info.sock,@buf,sizeof(buf),0);
if (k=0)OR(k=SOCKET_ERROR) then break;
send(info.TargetSock,@buf,k,0);
end;
info.ClientConnected:=false;
shutdown(info.TargetSock,SD_SEND);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Основная процедура сервера
procedure server(info:PCLIENT_INFO);stdcall;
var buf:array[0..1499] of byte;
dnsname:array[0..256] of char;
k,i:integer;
Version,nMethods:byte;
ip:TInAddr;
port:word;
sz:byte;
addr:TSockAddr;
target:TSocket;
const NoMethods:array[0..1] of byte=($05,$FF);
YeMethods:array[0..1] of byte=($05,$00);
SuccessConnect:array[0..3] of byte=($05,$00,$00,$01);
ErrorAtAddr:array[0..3] of byte=($05,$08,$00,$00);
begin
{Чтение запроса 1}
info.ClientConnected:=true;
RecvBuffer(info,Version,sizeof(Version));
RecvBuffer(info,nMethods,sizeof(nMethods));
if Version<>5 then begin
Shut(info);
writeln(' ! Error! Version must be 5');
end;
if nMethods=0 then begin
writeln(' ! Error! nMethods cannot be 0');
Shut(info);
end;
RecvBuffer(info,buf,nMethods);
k:=1;
for i:=0 to nMethods-1 do
if buf[i]=0 then begin
k:=0;
break;
end;
{Ответ 1}
if k=1 then begin
writeln(' ! Error! No good methods');
sendbuffer(info.sock,@NoMethods,sizeof(NoMethods));
Shut(info);
end;
sendbuffer(info.sock,@YeMethods,sizeof(NoMethods));
{Прием команды}
RecvBuffer(info,buf,4);
if buf[0]<>5 then begin
writeln(' ! Error! Version must be 5');
Shut(info);
end;
if buf[1]<>1 then begin
writeln(' ! Error! Only CONNECT command supported');
Shut(info);
end;
if buf[2]<>0 then begin
writeln(' ! Error! Rsv must be 0');
Shut(info);
end;
if (buf[3]<>1)and(buf[3]<>3) then begin
writeln(' ! Error! Only IPv4 or DNS address supported');
sendbuffer(info.sock,@ErrorAtAddr,sizeof(ErrorAtAddr));
Shut(info);
end;
zeromemory(@dnsname,sizeof(dnsname));
{Прием целевого адреса IPv4}
if buf[3]=1 then begin
RecvBuffer(info,ip,4);
end;
{Прием целевого адреса DNS}
if buf[3]=3 then begin
RecvBuffer(info,sz,1);
if sz=0 then begin
writeln(' ! Error in size of DNS address');
Shut(info);
end;
RecvBuffer(info,dnsname,sz);
ip:=dns(@dnsname);
if dword(ip)=0 then begin
writeln(' !Error host not found: ',pChar(@dnsname));
shut(info);
end;
end;
RecvBuffer(info,port,2);
if port=0 then begin
writeln(' !Error in port: ',htons(port));
shut(info);
end;
{Connect}
target:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if target=INVALID_SOCKET then begin
writeln('! Error at socket, ',WSAGetlastError);
Shut(info);
end;
info.TargetSock:=Target;
zeromemory(@addr,sizeof(addr));
addr.sin_family:=AF_INET;
addr.sin_port:=port;
addr.sin_addr:=ip;
if connect(target,addr,sizeof(addr))<>0 then begin
writeln(' ! Could not connect to target');
Shut(info);
end;
write;
info.TargetSock:=target;
write('# ',inet_ntoa(info.ClientAddr));
write(' -> ',pChar(@dnsname),' (',inet_ntoa(ip));
writeln(':',htons(port),'), ',GetTime);
info.TargetConnected:=true;
{Ответ на команду}
k:=sizeof(addr);
getsockname(Target,addr,k);
ip:=addr.sin_addr;
port:=addr.sin_port;
movememory(@buf,@SuccessConnect,4);
movememory(@buf[4],@ip,4);
movememory(@buf[6],@port,2);
sendbuffer(info.sock,@buf,10);
{Перенаправление данных Target->Client}
if CreateThread(nil,0,@ClientToTarget,info,0,cardinal(k))=0 then Shut(info);
while true do begin
zeromemory(@buf,sizeof(buf));
k:=recv(info.TargetSock,@buf,sizeof(buf),0);
if (k=0)OR(k=SOCKET_ERROR) then break;
send(info.sock,@buf,k,0);
end;
info.TargetConnected:=false;
shutdown(info.sock,SD_SEND);
k:=0;
while true do begin
if not info.ClientConnected then break
else Sleep(70);
inc(k);
if k=50 then break;
end;
closesocket(info.sock);
closesocket(info.TargetSock);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{#################################################################}
{
Вызывается для обслуживания нового соединения:
1. Выделяет память под информацию о клиенте
2. Инициализирует поля структуры
3. Выделяет память под временный буфер для данных из сети
4. Создает поток для обслуживания нового соединения
}
function NewClient(sock:TSocket; ClientAddr,ServerAddr:TInAddr):THandle;
var info:PCLIENT_INFO;
id:cardinal;
begin
GetMem(info,sizeof(CLIENT_INFO));
info.sock:=sock;
info.TargetSock:=0;
MoveMemory(@info.ClientAddr, @ClientAddr, sizeof(ClientAddr));
MoveMemory(@info.ServerAddr, @ServerAddr, sizeof(ServerAddr));
NewClient:=CreateThread(nil,0,@server,info,0,id);
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{Процедура инициализации}
procedure Entry(port:word);
var InitData:TWSAData;
local, peer:TSockAddr;
code,loclen,remlen:integer;
s1:TSocket;
Buf:array[0..255] of char;
ovp:TOVERLAPPED;
begin
if WSAStartup(MakeWord(2,2),InitData)<>0 then
error('! error at WSAStartup');
fillchar(local, sizeof(local), 0);
local.sin_family:=AF_INET;
local.sin_port:=htons(port);
MainSock:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if MainSock=INVALID_SOCKET then begin
WSACleanup();
error('! error at socket');
end;
if bind(MainSock, local, sizeof(local))<>0 then begin
closesocket(MainSock);
WSACleanup();
error('! error at bind');
end;
if listen(MainSock, NLISTEN)<>0 then begin
closesocket(MainSock);
WSACleanup();
error('! error at listen');
end;
SetConsoleCtrlHandler(@ConsoleEvent, TRUE);
writeln('* Start echo\n');
while true do begin
loclen:= sizeof(peer)+16;
remlen:=loclen;
s1:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if s1=INVALID_SOCKET then begin
closesocket(MainSock);
WSACleanup();
error('! error at socket');
end;
zeromemory(@ovp,sizeof(ovp));
ovp.hEvent:=CreateEvent(Nil, True, False, Nil);
if not acceptEx(MainSock,s1,@Buf,0,loclen,remlen,@code,@ovp) then begin
code:=WSAGetLastError;
if code=WSAECONNRESET then begin
closesocket(s1);
continue;
end;
end;
WaitForSingleObject(ovp.hEvent,INFINITE);
if not listened then begin
closesocket(s1);
WSACleanup();
writeln('! halt');
halt(0);
end;
movememory(@peer.sin_addr,@buf[42],4);
movememory(@local.sin_addr,@buf[14],4);
NewClient(s1,peer.sin_addr,local.sin_addr);
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{Точка входа}
var code:integer;
port:word;
BEGIN
if ParamCount<>1 then
error('Usage: echo.exe port');
val(ParamStr(1),port,code);
Entry(port);;
END.
|
