Raw UDP packets via Winsock2 on Delphi - delphi

Question

I can build a raw IP packet that contains a UDP packet that contains useful data (DNS request).
I can send it and see that it's sent in Wireshark. Wireshark parses it as a legal DNS request, so everything looks smoothly except the DNS answer - I get no answer, nothing.
My code (sorry, it's far from prod-level code):
var
D:WSAData;
SendSocket, ReceiveSocket: TSocket;
bytes: Integer;
bOpt : Integer;
Buf : TPacketBuffer;
SendAddrIn : TSockAddrIn;
RecvAddIn: TSockAddrIn;
sockAddrSize: Integer;
iTotalSize : Word;
begin
try
if WSAStartup($202, D)<>0 then
begin
writeln('error..');
exit;
end;
SendSocket:=socket(AF_INET, SOCK_RAW, IPPROTO_RAW);
if SendSocket=INVALID_SOCKET then
writeln(WSAGetLastError);
// Option: Header Include
bOpt := 1;
bytes := SetSockOpt(SendSocket, IPPROTO_IP, IP_HDRINCL, #bOpt, SizeOf(bOpt));
if bytes = SOCKET_ERROR then
begin
Writeln('setsockopt(IP_HDRINCL) failed: '+IntToStr(WSAGetLastError));
exit;
end;
BuildHeaders(SrcIP, SrcPort,
DestIP, DestPort,
dns,
Buf, SendAddrIn, iTotalSize);
Writeln(inttostr(iTotalSize) + ' bytes to send');
bytes := SendTo(SendSocket, buf, iTotalSize, 0, #SendAddrIn, SizeOf(SendAddrIn));
if bytes = SOCKET_ERROR then
writeln('sendto() failed: '+IntToStr(WSAGetLastError))
else
writeln('send '+IntToStr(bytes)+' bytes.');
ReceiveSocket:=socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
RecvAddIn.sin_addr.s_addr := htonl(0);
RecvAddIn.sin_family := AF_INET;
RecvAddIn.sin_port := htons(SrcPort);
if bind(ReceiveSocket, TSockAddr(RecvAddIn), sizeof(RecvAddIn)) = SOCKET_ERROR then
begin
writeln('bind() failed: '+IntToStr(WSAGetLastError));
exit;
end;
FillChar(buf, SizeOf(buf), 0);
sockAddrSize := sizeof(RecvAddIn);
bytes := RecvFrom(ReceiveSocket, buf, SizeOf(buf), 0, TSockAddr(RecvAddIn), sockAddrSize);
if bytes = SOCKET_ERROR then
writeln('RecvFrom() failed: '+IntToStr(WSAGetLastError))
else
writeln('RecvFrom '+IntToStr(bytes)+' bytes.');
CloseSocket(SendSocket);
CloseSocket(ReceiveSocket);
WSACleanup;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Wireshark shows this packet as:
I tried to create two sockets with the same local port to send and to receive data, each of its own type. What is wrong?..
UPDATE:
Thank you guys for the ideas.
Indeed, the receiving socket has to be fully initialized before any sending.
But as I've found - the main issue is with UDP packet checksum calculation. I've found out that a simple "ping" tool generates a checksum that doesn't equal the one generated by my code (of course, for the same input values). And when I just used their value (again, all the input values were preserved) - the DNS server returned the response!
To generate the checksum I use the next code:
function CheckSum(var Buffer; Size : integer) : Word;
type
TWordArray = array[0..1] of Word;
var
ChkSum : LongWord;
i : Integer;
begin
ChkSum := 0;
i := 0;
while Size > 1 do
begin
ChkSum := ChkSum + TWordArray(Buffer)[i];
inc(i);
Size := Size - SizeOf(Word);
end;
if Size=1 then
ChkSum := ChkSum + Byte(TWordArray(Buffer)[i]);
ChkSum := (ChkSum shr 16) + (ChkSum and $FFFF);
ChkSum := ChkSum + (Chksum shr 16);
Result := Word(ChkSum);
end;
procedure BuildHeaders(FromIP : string; iFromPort : Word;
ToIP : string; iToPort : Word;
StrMessage : TBytes; var Buf: TPacketBuffer;
var remote : TSockAddrIn; var iTotalSize: Word);
var
dwFromIP : LongWord;
dwToIP : LongWord;
iIPVersion : Word;
iIPSize : Word;
ipHdr : T_IP_Header;
udpHdr : T_UDP_Header;
iUdpSize : Word;
iUdpChecksumSize : Word;
cksum : Word;
Ptr : ^Byte;
procedure IncPtr(Value : Integer);
begin
ptr := pointer(integer(ptr) + Value);
end;
begin
dwFromIP := inet_Addr(PAnsiChar(AnsiString(FromIP)));
dwToIP := inet_Addr(PAnsiChar(AnsiString(ToIP)));
iTotalSize := sizeof(ipHdr) + sizeof(udpHdr) + length(strMessage);
iIPVersion := 4;
iIPSize := sizeof(ipHdr) div sizeof(LongWord);
//
// IP version goes in the high order 4 bits of ip_verlen. The
// IP header length (in 32-bit words) goes in the lower 4 bits.
//
ipHdr.ip_verlen := (iIPVersion shl 4) or iIPSize;
ipHdr.ip_tos := 0; // IP type of service
ipHdr.ip_totallength := htons(iTotalSize); // Total packet len
ipHdr.ip_id := $1545; // Unique identifier: set to 0
ipHdr.ip_offset := 0; // Fragment offset field
ipHdr.ip_ttl := 128;
ipHdr.ip_protocol := $11; // Protocol(UDP)
ipHdr.ip_checksum := 0 ; // IP checksum
ipHdr.ip_srcaddr := dwFromIP; // Source address
ipHdr.ip_destaddr := dwToIP; // Destination address
iUdpSize := sizeof(udpHdr) + length(strMessage);
udpHdr.src_portno := htons(iFromPort) ;
udpHdr.dst_portno := htons(iToPort) ;
udpHdr.udp_length := htons(iUdpSize) ;
udpHdr.udp_checksum := 0 ;
//
// Build the UDP pseudo-header for calculating the UDP checksum.
// The pseudo-header consists of the 32-bit source IP address,
// the 32-bit destination IP address, a zero byte, the 8-bit
// IP protocol field, the 16-bit UDP length, and the UDP
// header itself along with its data (padded with a 0 if
// the data is odd length).
//
iUdpChecksumSize := 0;
ptr := #buf[0];
FillChar(Buf, SizeOf(Buf), 0);
Move(ipHdr.ip_srcaddr, ptr^, SizeOf(ipHdr.ip_srcaddr));
IncPtr(SizeOf(ipHdr.ip_srcaddr));
iUdpChecksumSize := iUdpChecksumSize + sizeof(ipHdr.ip_srcaddr);
Move(ipHdr.ip_destaddr, ptr^, SizeOf(ipHdr.ip_destaddr));
IncPtr(SizeOf(ipHdr.ip_destaddr));
iUdpChecksumSize := iUdpChecksumSize + sizeof(ipHdr.ip_destaddr);
IncPtr(1);
Inc(iUdpChecksumSize);
Move(ipHdr.ip_protocol, ptr^, sizeof(ipHdr.ip_protocol));
IncPtr(sizeof(ipHdr.ip_protocol));
iUdpChecksumSize := iUdpChecksumSize + sizeof(ipHdr.ip_protocol);
Move(udpHdr.udp_length, ptr^, sizeof(udpHdr.udp_length));
IncPtr(sizeof(udpHdr.udp_length));
iUdpChecksumSize := iUdpChecksumSize + sizeof(udpHdr.udp_length);
move(udpHdr, ptr^, sizeof(udpHdr));
IncPtr(sizeof(udpHdr));
iUdpChecksumSize := iUdpCheckSumSize + sizeof(udpHdr);
Move(StrMessage[1], ptr^, Length(strMessage));
IncPtr(Length(StrMessage));
iUdpChecksumSize := iUdpChecksumSize + length(strMessage);
cksum := checksum(buf, iUdpChecksumSize);
udpHdr.udp_checksum := $FA8B;//cksum;
//
// Now assemble the IP and UDP headers along with the data
// so we can send it
//
FillChar(Buf, SizeOf(Buf), 0);
Ptr := #Buf[0];
Move(ipHdr, ptr^, SizeOf(ipHdr)); IncPtr(SizeOf(ipHdr));
Move(udpHdr, ptr^, SizeOf(udpHdr)); IncPtr(SizeOf(udpHdr));
Move(StrMessage[0], ptr^, length(StrMessage));
remote.sin_family := AF_INET;
remote.sin_port := htons(iToPort);
remote.sin_addr.s_addr := dwToIP;
end;
If anyone has another well-working implementation, please share...

Answer 1

You are creating separate sockets to send and receive the DNS packets, but you are creating the receiving socket after sending the request. It is possible/likely that the response arrives before the receiving socket is ready (use Wireshark to confirm that), in which case the response will simply be discarded by the OS.
You need to fully prepare the receiving socket before you send the request.

Answer 2

Ok, I've found the bug in the checksum calculation.
The next edition works fine and generates the correct checksum:
function CheckSum(var Buffer; Size : integer) : Word;
type
TWordArray = array[0..1] of Word;
var
ChkSum : LongWord;
i : Integer;
Item: Word;
begin
ChkSum := 0;
i := 0;
while Size > 1 do
begin
Item := TWordArray(Buffer)[i];
Item := Swap(Item);
ChkSum := ChkSum + Item;
inc(i);
Size := Size - SizeOf(Word);
end;
if Size=1 then
ChkSum := ChkSum + Byte(TWordArray(Buffer)[i]);
ChkSum := (ChkSum shr 16) + (ChkSum and $FFFF);
ChkSum := not ChkSum;
// ChkSum := ChkSum + (Chksum shr 16);
Result := Word(ChkSum);
end;
If you see any issues with it, please share your thoughts.