Необработанные пакеты UDP через Winsock2 в Delphi

Я могу создать необработанный IP-пакет, содержащий UDP-пакет, содержащий полезные данные (DNS-запрос). Я могу отправить его и увидеть, что он отправлен в Wireshark. Wireshark анализирует его как легальный DNS-запрос, поэтому все выглядит гладко, кроме ответа DNS — я не получаю ни ответа, ничего.

Мой код (извините, это далеко не код уровня продукта):

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 показывает этот пакет как: Необработанные пакеты UDP через Winsock2 в Delphi

Я попытался создать два сокета с одним и тем же локальным портом для отправки и получения данных, каждый своего типа. Что не так?..

Обновлено:

Спасибо, ребята, за идеи. Действительно, принимающий сокет должен быть полностью инициализирован перед любой отправкой. Но, как я обнаружил, основная проблема связана с вычислением контрольной суммы UDP-пакета. Я обнаружил, что простой инструмент "ping" генерирует контрольную сумму, которая не равна сумме, сгенерированной моим кодом (конечно, для тех же входных значений). А когда я просто использовал их значение (опять же, все входные значения сохранились) — DNS-сервер вернул ответ! Для генерации контрольной суммы я использую следующий код:

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;

Если у кого-то есть другая хорошо работающая реализация, пожалуйста, поделитесь...

Во-первых, вы пробовали, как в случае с dig, если вы отправляете один и тот же DNS-вопрос на тот же DNS-сервер с того же хоста, вы получаете ответ?

Patrick Mevzek 31.03.2022 17:15

К вашему сведению, PDU UDP называются «датаграммами», а не пакетами. Это прямо в имени протокола User Дейтаграмма Protocol.

Ron Maupin 31.03.2022 18:26
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
2
2
74
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Вы создаете отдельные сокеты для отправки и получения пакетов DNS, но вы создаете принимающий сокет после для отправки запроса. Возможно/вероятно, что ответ приходит до, принимающий сокет готов (используйте Wireshark, чтобы подтвердить это), и в этом случае ответ будет просто отброшен ОС.

Вам необходимо полностью подготовить принимающий сокет до, на который вы отправляете запрос.

Спасибо за идею, но, как я уже сказал, нет ответа, который фиксирует Wireshark. Только мой запрос, никаких ответов... И да, DNS-сервер работает нормально, проверяю с помощью ncat и того же дампа пакетов - отвечает

Zarathustra 31.03.2022 17:05

@Zarathustra "нет ответа, который фиксирует Wireshark" - извините, ваш вопрос не прояснил это. Тем не менее, это все еще ошибка, которую вы все равно должны исправить в своем коде. «Проверяю с помощью ncat и того же дампа пакетов - отвечает» — вы УВЕРЕНЫ, что ваш пакет ручного запроса соответствует точно, байт в байт, запросу, который отправляет ncat? На ВСЕХ слоях пакета?

Remy Lebeau 31.03.2022 17:08
Ответ принят как подходящий

Хорошо, я нашел ошибку в вычислении контрольной суммы.

Следующая редакция работает нормально и генерирует правильную контрольную сумму:

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;

Если вы видите какие-либо проблемы с этим, пожалуйста, поделитесь своими мыслями.

Я бы предложил использовать арифметику указателя вместо TWordArray. Во-первых, когда Size=1, чтение TWordArray(Buffer)[i] будет считывать 2 байта, хотя доступен только 1 байт. Это может или не может взорваться, в зависимости от того, как на самом деле выделена резервная копия памяти Buffer. Лично я бы присвоил @Buffer локальной переменной PByte, а затем продвигал бы эту переменную после каждого чтения. В противном случае вы можете хотя бы изменить TWordArray(Buffer)[i] на (PWord(@Buffer)+i)^ и Byte(TWordArray(Buffer)[i]) на PByte(@Buffer)^.

Remy Lebeau 01.04.2022 00:44

Другие вопросы по теме