Не работает редирект

[SergeySW]

Пытаюсь сделать редирект пакетов. Не работает 🙁
Может кто подскажет в чем ошибка?

{$APPTYPE CONSOLE}



uses

SysUtils,

Windows,

Winsock,

winpkf,

iphlp;



var

iIndex : DWORD;

hFilt : THANDLE;

Adapts : TCP_AdapterList;

AdapterMode : ADAPTER_MODE;

Buffer : INTERMEDIATE_BUFFER;

ReadRequest : ETH_REQUEST;

hEvent : THANDLE;

hAdapter : THANDLE;

pEtherHeader : TEtherHeaderPtr;

pIPHeader : TIPHeaderPtr;

pTcpHeader : TTCPHeaderPtr;

aaLen, testSum : dword;





function IPAddrToName(IPAddr : string) : string;

var

SockAddrIn : TSockAddrIn;

HostEnt : PHostEnt;

WSAData : TWSAData;

begin

WSAStartup($101, WSAData);

SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));

HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);

if HostEnt <> nil then

begin

result := StrPas(Hostent^.h_name)

end

else

begin

result := '';

end;

end;





// Calculate TCP checkcum

function RecalculateTCPChecksum(aLen: Integer; aSrcAddr, aDstAddr: Cardinal; buff: PByteArray): Word;

var

w16,padd: word;

i,sum: ulong;

sIP,dIP: in_addr;

begin

padd := 0;

sum := 0;

if (aLen div 2) * 2 <> aLen then begin

padd := 1;

buff[aLen] := 0;

end;

i := 0;

while i < aLen+padd do begin

w16 := ((buff shl 8)and $FF00) + (buff[i+1]and $FF);

sum := sum + dword(w16);

i := i + 2;

end;



//add IP length

sIP := in_addr(aSrcAddr);

dIP := in_addr(aDstAddr);

sum := sum + ntohs(sIP.S_un_w.s_w1) + ntohs(sIP.S_un_w.s_w2);

sum := sum + ntohs(dIP.S_un_w.s_w1) + ntohs(dIP.S_un_w.s_w2);

sum := sum + IPPROTO_TCP + word(aLen);



while (sum shr 16)>0 do

sum := (sum and $FFFF)+(sum shr 16);



sum := not sum;

sum := htons(sum);

Result := sum;

end;



function Checksum(p: PWORD; Size: word): WORD;

var

i: Integer;

Sum: DWORD;

begin

Sum := 0;

for i := 0 to Size - 1 do

begin

Sum := Sum + ntohs(p^);

inc(p);

end;

while (Sum shr 16) > 0 do

Sum := (Sum and $FFFF) + (Sum shr 16);

Sum := not Sum;

Result := Sum;

end;





procedure ReleaseInterface();

begin

// Restore default mode

AdapterMode.dwFlags := 0;

AdapterMode.hAdapterHandle := hAdapter;

SetAdapterMode(hFilt, @AdapterMode);



// Set NULL event to release previously set event object

SetPacketEvent(hFilt, hAdapter, 0);



// Close Event

if hEvent <> 0 then

CloseHandle(hEvent);



// Close driver object

CloseFilterDriver(hFilt);



// Release NDISAPI

FreeNDISAPI();

end;



begin



// Check the number of parameters

if ParamCount() < 2 then

begin

Writeln('Command line syntax:');

Writeln('   PassThru.exe index num');

Writeln('   index - network interface index.');

Writeln('   num - number or packets to filter');

Writeln('You can use ListAdapters to determine correct index.');

//   Exit;

end;



// Initialize NDISAPI

InitNDISAPI();



// Create driver object

hFilt := OpenFilterDriver('NDISRD');



if IsDriverLoaded(hFilt) then

begin



// Get parameters from command line

//iIndex := StrToInt(ParamStr(1));

//counter := StrToInt(ParamStr(2));

iIndex := 2;



// Set exit procedure

ExitProcessProc := ReleaseInterface;



// Get TCP/IP bound interfaces

GetTcpipBoundAdaptersInfo(hFilt, @Adapts);



// Check paramer values

if iIndex > Adapts.m_nAdapterCount then

begin

Writeln('There is no network interface with such index on this system.');

Exit;

end;



hAdapter := Adapts.m_nAdapterHandle[iIndex];



AdapterMode.dwFlags := MSTCP_FLAG_SENT_TUNNEL or MSTCP_FLAG_RECV_TUNNEL ;

AdapterMode.hAdapterHandle := hAdapter;



// Create notification event

hEvent := CreateEvent(nil, TRUE, FALSE, nil);



if hEvent <> 0 then

if SetPacketEvent(hFilt, hAdapter, hEvent) <> 0 then

begin

// Initialize request

ReadRequest.EthPacket.Buffer := @Buffer;

ReadRequest.hAdapterHandle := hAdapter;



SetAdapterMode(hFilt, @AdapterMode);



while true do

begin

WaitForSingleObject(hEvent, INFINITE);

while ReadPacket(hFilt, @ReadRequest) <> 0 do

begin

pEtherHeader := TEtherHeaderPtr(@Buffer.m_IBuffer);



if ntohs(pEtherHeader.h_proto) = ETH_P_IP then

begin

pIPHeader := TIPHeaderPtr(Dword(pEtherHeader)+SizeOf(TEtherHeader));

if pIPHeader.Protocol = IPPROTO_TCP then

begin

pTcpHeader := TTCPHeaderPtr(Dword(pIPHeader)+(pIPHeader.VerLen and $F) * 4);



if pIPHeader.DestIp=(inet_addr('10.10.10.17')) then

begin

pIPHeader.DestIp := (inet_addr('10.11.11.71'));



//     Writeln('     OLD TCP checksum =    ', IntToStr(dword(ntohs(pTCPHeader.Checksum))));



aaLen := ntohs(pIPHeader.TotalLen) - ((pIPHeader.VerLen and $F)*4);

pTCPHeader.Checksum := 0;

testSum := RecalculateTCPChecksum(aaLen, pIPHeader.SourceIp, pIPHeader.DestIp, PByteArray(pTCPHeader));

pTCPHeader.Checksum := testSum;



//          Writeln('     NEW TCP checksum =    ', IntToStr(ntohs(pTCPHeader.Checksum)));

//          Writeln('');



//          Writeln('     OLD IP checksum =    ', IntToStr(dword(ntohs(pIPHeader.Checksum))));

pIPHeader.Checksum := 00;

pIPHeader.Checksum := htons(Checksum(Pword(pIPHeader), ((pIPHeader.VerLen and $F) * 4) div 2));

//          Writeln('     NEW IP checksum =    ', IntToStr(dword(ntohs(pIPHeader.Checksum))));

end;



end;





end;



// if ntohsn(pEtherHeader.h_proto) = ETH_P_RARP then

//   Writeln('     Reverse Addr Res packet');



// if ntohsn(pEtherHeader.h_proto) = ETH_P_ARP then

//   Writeln('     Address Resolution packet');



//Writeln('__');







if Buffer.m_dwDeviceFlags = PACKET_FLAG_ON_SEND then

// Place packet on the network interface

SendPacketToAdapter(hFilt, @ReadRequest)

else

// Indicate packet to MSTCP

SendPacketToMstcp(hFilt, @ReadRequest);

end;

ResetEvent(hEvent);

end;

end;

end;

end.

[Vadim Smirnov]

неплохо было бы описать все-таки как это предполагается должно работать…

[SergeySW]

Предполагалось поставить на сервер с NAT на внешний интерфейс и пакеты от незарегитсрированных пользователей перенаправлять на отдельный сервер со страницей регистрации .

[Vadim Smirnov]

Я Дельфи не очень читаю, поэтому лучше расскажу как это надо было делать.

Если собираешься фильтровать на внешнем интерфейсе и меняешь destination IP, то нужно запомнить какое соединение и как ты изменил (source IP/port, original destination IP/port). Иначе пакет с измененным (TCP SYSN) IP адресом выйдет наружу, удаленный сервер (на который был осуществлен редирект) тебе ответит(TCP ACK), а затем в полученном от этого сервера на внешний интерфейс пакете нужно будет заменить source IP/port (они на момент получения принадлежат серверу на который был осуществлен редирект) на те которые были изначально (куда собственно клиент стучался). Ну и так далее для всех последующих пакетов. У тебя же в коде всего одна проверка на адрес, и такой логики судя по всему не присутствует.

Хотя обычно такая фильтрация делается на внутреннем интерфейсе с редиректом на локальный HTTP сервер. Так как то правильней чем редиректить с внешнего куда-то на удаленный сервер.

[SergeySW]

Переделал тестовый вариант так как вы советовали. Не заработало 🙁
Тестирую у себя локально на компе. По http запрашиваю адрес 10.10.10.17

{$APPTYPE CONSOLE}



uses

SysUtils,

Windows,

Winsock,

winpkf,

iphlp;



var

iIndex : DWORD;

hFilt : THANDLE;

Adapts : TCP_AdapterList;

AdapterMode : ADAPTER_MODE;

Buffer : INTERMEDIATE_BUFFER;

ReadRequest : ETH_REQUEST;

hEvent : THANDLE;

hAdapter : THANDLE;

pEtherHeader : TEtherHeaderPtr;

pIPHeader : TIPHeaderPtr;

pTcpHeader : TTCPHeaderPtr;

aaLen, testSum : dword;

RecalcChecksum : boolean;





function IPAddrToName(IPAddr : string) : string;

var

SockAddrIn : TSockAddrIn;

HostEnt : PHostEnt;

WSAData : TWSAData;

begin

WSAStartup($101, WSAData);

SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));

HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);

if HostEnt <> nil then

begin

result := StrPas(Hostent^.h_name)

end

else

begin

result := '';

end;

end;





// Calculate TCP checkcum

function RecalculateTCPChecksum(aLen: Integer; aSrcAddr, aDstAddr: Cardinal; buff: PByteArray): Word;

var

w16,padd: word;

i,sum: ulong;

sIP,dIP: in_addr;

begin

padd := 0;

sum := 0;

if (aLen div 2) * 2 <> aLen then begin

padd := 1;

buff[aLen] := 0;

end;

i := 0;

while i < aLen+padd do begin

w16 := ((buff shl 8)and $FF00) + (buff[i+1]and $FF);

sum := sum + dword(w16);

i := i + 2;

end;



//add IP length

sIP := in_addr(aSrcAddr);

dIP := in_addr(aDstAddr);

sum := sum + ntohs(sIP.S_un_w.s_w1) + ntohs(sIP.S_un_w.s_w2);

sum := sum + ntohs(dIP.S_un_w.s_w1) + ntohs(dIP.S_un_w.s_w2);

sum := sum + IPPROTO_TCP + word(aLen);



while (sum shr 16)>0 do

sum := (sum and $FFFF)+(sum shr 16);



sum := not sum;

sum := htons(sum);

Result := sum;

end;



function Checksum(p: PWORD; Size: word): WORD;

var

i: Integer;

Sum: DWORD;

begin

Sum := 0;

for i := 0 to Size - 1 do

begin

Sum := Sum + ntohs(p^);

inc(p);

end;

while (Sum shr 16) > 0 do

Sum := (Sum and $FFFF) + (Sum shr 16);

Sum := not Sum;

Result := Sum;

end;





procedure ReleaseInterface();

begin

// Restore default mode

AdapterMode.dwFlags := 0;

AdapterMode.hAdapterHandle := hAdapter;

SetAdapterMode(hFilt, @AdapterMode);



// Set NULL event to release previously set event object

SetPacketEvent(hFilt, hAdapter, 0);



// Close Event

if hEvent <> 0 then

CloseHandle(hEvent);



// Close driver object

CloseFilterDriver(hFilt);



// Release NDISAPI

FreeNDISAPI();

end;



begin



// Check the number of parameters

if ParamCount() < 2 then

begin

Writeln('Command line syntax:');

Writeln('   PassThru.exe index num');

Writeln('   index - network interface index.');

Writeln('   num - number or packets to filter');

Writeln('You can use ListAdapters to determine correct index.');

//   Exit;

end;



// Initialize NDISAPI

InitNDISAPI();



// Create driver object

hFilt := OpenFilterDriver('NDISRD');



if IsDriverLoaded(hFilt) then

begin



// Get parameters from command line

//iIndex := StrToInt(ParamStr(1));

//counter := StrToInt(ParamStr(2));

iIndex := 2;



// Set exit procedure

ExitProcessProc := ReleaseInterface;



// Get TCP/IP bound interfaces

GetTcpipBoundAdaptersInfo(hFilt, @Adapts);



// Check paramer values

if iIndex > Adapts.m_nAdapterCount then

begin

Writeln('There is no network interface with such index on this system.');

Exit;

end;



hAdapter := Adapts.m_nAdapterHandle[iIndex];



AdapterMode.dwFlags := MSTCP_FLAG_SENT_TUNNEL or MSTCP_FLAG_RECV_TUNNEL ;

AdapterMode.hAdapterHandle := hAdapter;



// Create notification event

hEvent := CreateEvent(nil, TRUE, FALSE, nil);



if hEvent <> 0 then

if SetPacketEvent(hFilt, hAdapter, hEvent) <> 0 then

begin

// Initialize request

ReadRequest.EthPacket.Buffer := @Buffer;

ReadRequest.hAdapterHandle := hAdapter;



SetAdapterMode(hFilt, @AdapterMode);



while true do

begin

WaitForSingleObject(hEvent, INFINITE);

while ReadPacket(hFilt, @ReadRequest) <> 0 do

begin

pEtherHeader := TEtherHeaderPtr(@Buffer.m_IBuffer);



if ntohs(pEtherHeader.h_proto) = ETH_P_IP then

begin

pIPHeader := TIPHeaderPtr(Dword(pEtherHeader)+SizeOf(TEtherHeader));

if pIPHeader.Protocol = IPPROTO_TCP then

begin

RecalcChecksum:=false;

pTcpHeader := TTCPHeaderPtr(Dword(pIPHeader)+(pIPHeader.VerLen and $F) * 4);



if pIPHeader.DestIp=(inet_addr('10.10.10.17')) then

begin

RecalcChecksum:=true;

pIPHeader.DestIp := (inet_addr('10.11.11.71'));

end;



if (pIPHeader.SourceIp=(inet_addr('10.11.11.71')))then

begin

RecalcChecksum:=true;

pIPHeader.SourceIp := (inet_addr('10.10.10.17'));

end;



if RecalcChecksum then

begin

aaLen := ntohs(pIPHeader.TotalLen) - ((pIPHeader.VerLen and $F)*4);

pTCPHeader.Checksum := 0;

testSum := RecalculateTCPChecksum(aaLen, pIPHeader.SourceIp, pIPHeader.DestIp, PByteArray(pTCPHeader));

pTCPHeader.Checksum := testSum;



pIPHeader.Checksum := 00;

pIPHeader.Checksum := htons(Checksum(Pword(pIPHeader), ((pIPHeader.VerLen and $F) * 4) div 2));

end;

end;

end;



// if ntohsn(pEtherHeader.h_proto) = ETH_P_RARP then

//   Writeln('     Reverse Addr Res packet');



// if ntohsn(pEtherHeader.h_proto) = ETH_P_ARP then

//   Writeln('     Address Resolution packet');



//Writeln('__');







if Buffer.m_dwDeviceFlags = PACKET_FLAG_ON_SEND then

// Place packet on the network interface

SendPacketToAdapter(hFilt, @ReadRequest)

else

// Indicate packet to MSTCP

SendPacketToMstcp(hFilt, @ReadRequest);

end;

ResetEvent(hEvent);

end;

end;

end;

end.

[Vadim Smirnov]

Ну это не так как я советовал, судя по тому сколько в коде изменилось…

Вообще, если что-то не работает или работает не так как ожидается, я бы поставил сниффер типа Network Monitor и начал разбираться, с тем какие пакеты куда и как ходят. Сделать нормальный редирект в четыре строчки не получится, могу сразу сказать. Можете посмотреть пример NAT в Internet Gateway, это почти то же самое по работе с пакетами, просто задача другая. А разбираться с чужим неработающим кодом занятие неблагодарное, ну если, конечно, не за отдельные деньги 8)

[Author]

Posts