Lenght Control over GetRegistersFromBuffer and PutRegistersIntoBuffer

[federico32]

I recommend adding a length control on GetRegistersFromBuffer and PutRegistersIntoBuffer to avoid an unhandled exception. The solution I implemented was:

if (Length(data) < Count - 1) or (Length(data)=0) or (Count = 0) then
  begin
       raise exception.Create('GetRegistersFromBuffer Data Length error ');
  end; 

Example :

procedure GetRegistersFromBuffer(const Buffer: PWord; const Count: Word; var Data: array of Word);
var
  WPtr: PWord;
  i: Word;
begin
  WPtr := Buffer;
  if (Length(data) < Count - 1) or (Length(data)=0) or (Count = 0) then
  begin
       raise exception.Create('GetRegistersFromBuffer Data Length error ');
  end;
  for i := 0 to (Count - 1) do
  begin
    Data[i] := Swap16(WPtr^);
    Inc(WPtr);
  end;
end;  

Thanks for the component

[federico32]

On SendResponse, i prefer check ValidRequestand SendErrorto avoid an exception.

{$IFDEF DMB_INDY10}
procedure TIdModBusServer.SendResponse(const AContext: TIdContext;
  const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData);
{$ELSE}
procedure TIdModBusServer.SendResponse(const AThread: TIdPeerThread;
  const ReceiveBuffer: TModBusRequestBuffer; const Data: TModRegisterData);
{$ENDIF}
var
  SendBuffer: TModBusResponseBuffer;
  L: Integer;
  ValidRequest : Boolean;
{$IFDEF DMB_INDY10}
  Buffer: TIdBytes;
{$ENDIF}
begin
  if Active then
  begin

    {Check Valid }
    ValidRequest  := false;
    FillChar(SendBuffer, SizeOf(SendBuffer), 0);
    SendBuffer.Header.TransactionID := ReceiveBuffer.Header.TransactionID;
    SendBuffer.Header.ProtocolID := ReceiveBuffer.Header.ProtocolID;
    SendBuffer.Header.UnitID := ReceiveBuffer.Header.UnitID;
    SendBuffer.FunctionCode := ReceiveBuffer.FunctionCode;
    SendBuffer.Header.RecLength := Swap16(0);

    case ReceiveBuffer.FunctionCode of
      mbfReadCoils,
      mbfReadInputBits:
        begin
          L := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if (L > 0) and (L <= MaxCoils) then
          begin
            SendBuffer.MBPData[0] := Byte((L + 7) div 8);
            PutCoilsIntoBuffer(@SendBuffer.MBPData[1], L, Data);
            SendBuffer.Header.RecLength := Swap16(3 + SendBuffer.MBPData[0]);
            ValidRequest  := true;
          end;
        end;
      mbfReadInputRegs,
      mbfReadHoldingRegs:
        begin
          L := Swap16(Word((@ReceiveBuffer.MBPData[2])^));
          if (L > 0) and (L <= MaxBlockLength) then
          begin
            SendBuffer.MBPData[0] := Byte(L shl 1);
            PutRegistersIntoBuffer(@SendBuffer.MBPData[1], L, Data);
            SendBuffer.Header.RecLength := Swap16(3 + SendBuffer.MBPData[0]);
            ValidRequest  := true;
          end;
        end;
    else
      begin
        SendBuffer.MBPData[0] := ReceiveBuffer.MBPData[0];
        SendBuffer.MBPData[1] := ReceiveBuffer.MBPData[1];
        SendBuffer.MBPData[2] := ReceiveBuffer.MBPData[2];
        SendBuffer.MBPData[3] := ReceiveBuffer.MBPData[3];
        SendBuffer.Header.RecLength := Swap16(6);
        ValidRequest  := true;
      end;
    end;
    {Send buffer if Request is Valid}
    if ValidRequest then
    begin
    {$IFDEF DMB_INDY10}
      Buffer := RawToBytes(SendBuffer, Swap16(SendBuffer.Header.RecLength) + 6);
      AContext.Connection.Socket.WriteDirect(Buffer);
      if FLogEnabled then
        LogResponseBuffer(AContext, SendBuffer, Swap16(SendBuffer.Header.RecLength) + 6);
    {$ELSE}
      AThread.Connection.Socket.Send(SendBuffer, Swap16(SendBuffer.Header.RecLength) + 6);
      if FLogEnabled then
        LogResponseBuffer(AThread, SendBuffer, Swap16(SendBuffer.Header.RecLength) + 6);
    {$ENDIF}
    end
    else
    begin
      {Send error for invalid request}
    {$IFDEF DMB_INDY10}
      SendError(AContext, mbeServerFailure, ReceiveBuffer);
    {$ELSE}
      SendError(AThread, mbeServerFailure, ReceiveBuffer);
    {$ENDIF}
       exit;
    end;
  end;
end;

[plpolak]

Changes look good to me. I have merged them into the develop branch.