Search code examples
delphidnsudpwinsock2

Raw UDP packets via Winsock2 on Delphi

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: Packet seems sent correctly

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...

Solution

  • 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.