ANTICHAT — форум по информационной безопасности, OSINT и технологиям

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.