Home > other >  Raw UDP packets via Winsock2 on Delphi
Raw UDP packets via Winsock2 on Delphi

Time:04-01

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

CodePudding user response:

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.

CodePudding user response:

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.

  • Related