Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: TidTCPServer AV when TCP port open to internet


This question is not answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 11 - Last Post: Aug 28, 2017 4:09 PM Last Post By: Registered User
Registered User

Posts: 46
Registered: 3/4/05
TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 23, 2017 8:15 PM
(Update: AV error was actually in my code - freeing an object variable that was not initialized when unexpected messages were received and was not directly related to Indy).

Hi

Somehow while hackers(?) are port probing my server its possible to get an access violation in this Indy code:

procedure TIdCustomTCPServer.ContextDisconnected(AContext: TIdContext);
var
  // under ARC, convert weak references to strong references before working with them
  LIOHandler: TIdIOHandler;
  LIntercept: TIdConnectionIntercept;
begin
  DoDisconnect(AContext);
  LIOHandler := AContext.Connection.IOHandler;
  if Assigned(LIOHandler) then begin
    LIntercept := LIOHandler.Intercept; //exception here
    if Assigned(LIntercept) then begin
      LIntercept.Disconnect;
      FreeAndNil(LIntercept);
      LIOHandler.Intercept := nil;
    end;
  end;
end;
 


What appears to be happening is the port probes are connecting multiple times from the same IP, they somehow can get 2 x contexts into the Context list, when one is freed through a normal disconnect the other is left and also tries to disconnect causing the access violation.

I have seen two identical memory addresses in the context list and cant see how they could get there.

Either that or there is a buffer overwrite that's causing the TCP serve to die is my other idea.

Im using a custom context (TIdServerContext)


Constructor TSmartDeviceConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  Inherited;
 
  FBuffer := '';
  FLastMsgReceived := now;
  FLastMsgSent := Now;
  FTXQueue := TIdThreadSafeStringList.Create;
 
end;
 
// i can pickup the error as my FTXQueue is nil - however i cannot prevent an AV in the TIdCustomTCPServer.ContextDisconnected procedure.
 
Destructor TSmartDeviceConnection.Destroy;
begin
 
  //Debug Testing - dont need the bit after exit
  if FTXQueue = nil then
  begin
    Exit;
 
    if FTXQueue <> nil then
      FTXQueue.Free;
  end;
 
 
  if FTXQueue <> nil then
    FTXQueue.Free;
 
  FTXQueue := Nil;
 
 
 
  Inherited;
end;
 


Here is my execute handler, incase im killing something i shouldnt, no AV's raised here though.


procedure TSmartDeviceDriver.FTCPServerExecute(AContext: TIdContext);
var
  Queue: TStringList;
  TmpList: TStringList;
 
  LLine: String;
  TempChar : Char;
  IncommingStr : String;
  TempBuffer : TidBytes;
  Count : Integer;
  ReadLength : Integer;
  //DestEncoding : TEncoding;
  JSONTXMsg : TJSONObject;
 
  //Count : Integer;
 
  DeviceContext : TSmartDeviceConnection;
begin
 
  //sleep(1);
 
  //if the TX buffer has messages on the outgoing have to wait for them to be sent
  //while FCommsTXBuffer.Count > 0 do
  //  sleep(1);
  DeviceContext := TSmartDeviceConnection(AContext);
 
  if AContext = nil then
    Exit;
 
  if DeviceContext.FTXQueue = nil then
    Exit;
 
  if AContext <> nil then
  try
 
 
    //Writing Anything that is in the que to go out.
    try
      tmpList := nil;
 
      Queue := DeviceContext.FTXQueue.Lock;
 
      try
 
        if Queue.Count > 0 then
        begin
          TmpList := TStringList.Create;
          TmpList.Assign(Queue);
          Queue.Clear;
        end;
 
      finally
        DeviceContext.FTXQueue.Unlock;
      end;
 
      if TmpList <> nil then
        for Count := 0 to TmpList.Count-1 do
        begin
 
          DeviceContext.Connection.IOHandler.Write(TmpList.Strings[Count],IndyTextEncoding_UTF8);
    
        end;
 
    finally
      tmpList.Free;
    end;
 
    //DestEncoding := TEncoding.UTF8;
 
    IncommingStr := '';
 
    if not AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin
      //
      SetLength(TempBuffer, AContext.Connection.IOHandler.InputBuffer.size);
 
      //DeviceContext.Connection.IOHandler.ReadBytes(TempBuffer,AContext.Connection.IOHandler.InputBuffer.size,False);
 
      try
        IncommingStr := DeviceContext.Connection.IOHandler.InputBufferAsString(IndyTextEncoding_UTF8);
      except
        on E: Exception do
          if E is EIdException then raise;//logging here had issue with encoding/ decoding.
      end;
    end;
 
 
    if Length(IncommingStr) > 0 then
    begin
      DeviceContext.FProcessData(IncommingStr);
    end
    else
    begin
 
      //Send a periodic Ping Message to test the connection
      if DeviceContext.FLastMsgSent < IncSecond(now,-30) then
        DeviceContext.FPing;
 
      //Sleeping here so we dont spin CPU cycles.
      TThread.Sleep(1);
 
    end;
 
    //Kill off any connections that havent received a message for 1 minute.
    if DeviceContext.FLastMsgReceived < IncSecond(Now,-60) then
      if DeviceContext.Connection.Connected then
      begin
        DeviceContext.Connection.Disconnect;
        Exit;
      end;
 
    //This Flag Set by main thread.
    if DeviceContext.FDisconnect then
    begin
      DeviceContext.Connection.Disconnect;
      Exit;
    end;
 
  except
    on E: Exception do
     if E is EIdException then raise;
  end;
 
end;
 


Any ideas how to fix this issue or spot any errors in the above code?

The issue i have is i then get subsequent A/V errors that just keep crashing the TCP server - stack overwrite or something.

Using Berlin 10.1

Edited by: Registered User on Aug 23, 2017 8:17 PM

Edited by: Registered User on Aug 23, 2017 8:29 PM

Edited by: Registered User on Aug 24, 2017 10:53 PM
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TidTCPServer AV when TCP port open to internet [Edit]  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 12:11 PM   in response to: Registered User in response to: Registered User
Registered User wrote:

Somehow while hackers(?) are port probing my server its possible to
get an access violation in this Indy code:

Then you are doing something wrong in your server code. The code you
quoted runs when a client has disconnected (or is in the process of
being disconnected) and Indy is cleaning up the thread that managed
that client. Hackers cannot affect that code, so it has to be
something you are doing on your end to mess it up.

LIntercept := LIOHandler.Intercept; //exception here

The only way that can happen is if LIOHandler is pointing at an invalid
TIdIOHandler object. Which, under normal conditions, does not happen.
So you have to be doing something to mismanage or corrupt the IOHandler
object.

What appears to be happening is the port probes are connecting
multiple times from the same IP, they somehow can get 2 x contexts
into the Context list, when one is freed through a normal disconnect
the other is left and also tries to disconnect causing the access
violation.

Each context is independent. Each TIdTCPServer binding runs in its own
thread, running a loop that checks for incoming connections. Two
connects to the same port will be processed sequentially. The first
connect will be seen, create a new context with its own
TIdTCPConnection and TIdIOHandler objects, and start up a thread to
manage that client. Then the next loop iteration will see the second
connect and start up a new context and thread for it. The two contexts
are run in parallel independantly from each other with no link between
them.

I have seen two identical memory addresses in the context list and
cant see how they could get there.

That is simply not possible, unless you are messing around with the
list contents manually.

A context object is added to the list only when it first starts
running, and is removed when it stops running.

Even if you have multiple ports open, with multiple threads listening
for clients, and multiple clients connect to separate ports at the same
time, it would still create independent context objects and threads,
and the Contexts list is protected from concurrent access, so you still
couldn't get duplicate context addresses in the list.

There is simply no window of oppurtunity for duplicate addresses to
appear in the list.

Either that or there is a buffer overwrite that's causing the TCP
serve to die is my other idea.

If there is, it would have to be in your code, not in Indy's.

Im using a custom context (TIdServerContext)

Are you setting the server's ContextClass property before activating
the server?

//Debug Testing - dont need the bit after exit
if FTXQueue = nil then
begin
Exit;

if FTXQueue <> nil then
FTXQueue.Free;
end;

if FTXQueue <> nil then
FTXQueue.Free;

FTXQueue := Nil;


TObject.Free() already checks for nil, so your manual checks for nil
are redundant and should be removed:

destructor TSmartDeviceConnection.Destroy;
begin
  FTXQueue.Free;
  inherited;
end;


Here is my execute handler, incase im killing something i shouldnt

No, but I do see some logic problems with it.

For one thing, what do your strings actually look like back and forth?
How are they delimited so you know where one string ends and next
begins? You are not delimiting your outbound strings in this code, so
are they pre-delimited when put into the queue?

But more importantly, your inbound reading is not handling any
delimiters at all, so you have no way of knowing when you have a
complete string before passing it to FProcessData(), or even if you
have complete UTF-8 byte sequences in the InputBuffer before extracting
decoded strings from it.

You can't just blindly send strings without delimiting them. TCP is a
stream of bytes, it has no concept of message framing. You have to
implement that in your protocol data.

At a bare minimum, you should either:

- use a line break as your text message delimiter

- send string lengths before sending string data

Try something more like this:

type
  TSmartDeviceConnection = class(TIdServerContext)
  public
    FTXQueue: TIdThreadSafeStringList;
    FLastMsgReceived,
    FLastMsgSent: TIdTicks;
    ...
 
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
 
    procedure SendStr(const S: String);
    function ReadStr: String;
 
    procedure FPing;
 
    ...
  end;
 
constructor TSmartDeviceConnection.Create(AConnection:
TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited;
  FTXQueue := TIdThreadSafeStringList.Create;
  FLastMsgReceived := Ticks64;
  FLastMsgSent := FLastMsgReceived;
  ...
end;
 
destructor TSmartDeviceConnection.Destroy;
begin
  FTXQueue.Free;
  inherited;
end;
 
procedure TSmartDeviceConnection.SendStr(const S: String);
var
  Buf: TIdBytes;
begin
  { if you want to use a line break as a string delimiter }
  Connection.IOHandler.WriteLn(S);
 
  { if you want to prefix the string data with the string length }
  Buf := IndyTextEncoding_UTF8.GetBytes(S);
  with Connection.IOHandler do
  begin
    Write(Int32(Length(Buf)));
    Write(Buf);
  end;
 
  FLastMsgSent := Ticks64;
end;
 
function TSmartDeviceConnection.ReadStr: String;
begin
  { if you want to use a line break as a string delimiter }
  Result := Connection.IOHandler.ReadLn;
 
  { if you want to prefix the string data with the string length }
  with Connection.IOHandler do
    Result := ReadString(ReadInt32);
 
  if Result <> '' then
    FLastMsgReceived := Ticks64;
end;
 
procedure TSmartDeviceConnection.FPing;
begin
  SendStr('...');
end;
 
procedure TSmartDeviceDriver.FTCPServerConnect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.DefStringEncoding :=
IndyTextEncoding_UTF8;
  AContext.Connection.IOHandler.ReadTimeout := 5000;
end;
 
procedure TSmartDeviceDriver.FTCPServerExecute(AContext: TIdContext);
var
  Queue, TmpList: TStringList;
  IncommingStr: String;
  I: Integer;
  DeviceContext : TSmartDeviceConnection;
begin
  DeviceContext := AContext as TSmartDeviceConnection;
 
  if DeviceContext.FDisconnect then
  begin
    DeviceContext.Connection.Disconnect;
    Exit;
  end;
 
  tmpList := nil;
  try
    Queue := DeviceContext.FTXQueue.Lock;
    try
      if Queue.Count > 0 then
      begin
        TmpList := TStringList.Create;
        TmpList.Assign(Queue);
        Queue.Clear;
      end;
    finally
      DeviceContext.FTXQueue.Unlock;
    end;
 
    if TmpList <> nil then
    begin
      for I := 0 to TmpList.Count-1 do
      begin
        if DeviceContext.FDisconnect then
        begin
          DeviceContext.Connection.Disconnect;
          Exit;
        end;
        DeviceContext.SendStr(TmpList.Strings[I]);
      end;
    end;
  finally
    tmpList.Free;
  end;
 
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.CheckForDataOnSource(10);
    AContext.Connection.IOHandler.CheckForDisconnect;
 
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin
      if DeviceContext.FDisconnect or
        (GetElapsedTicks(DeviceContext.FLastMsgReceived) >= 60000) then
      begin
        DeviceContext.Connection.Disconnect;
        Exit;
      end;
 
      if GetElapsedTicks(DeviceContext.FLastMsgSent) >= 30000 then
        DeviceContext.FPing;
 
      Exit;
    end;
  end;
 
  if DeviceContext.FDisconnect then
  begin
    DeviceContext.Connection.Disconnect;
    Exit;
  end;
 
  IncommingStr := DeviceContext.ReadStr;
  DeviceContext.FProcessData(IncommingStr);
end;


--
Remy Lebeau (TeamB)
Registered User

Posts: 46
Registered: 3/4/05
Re: TidTCPServer AV when TCP port open to internet [Edit]  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 4:49 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Thankyou Remmy I was hoping you would comment.

I am definitely not manually adding any objects to the Contex list. When I catch the error in the IDE i can see two identical memory addresses in the context list - this is what is killing the server. I get a disconnect fired twice for same object, that has already been freed by indy. AV on the second disconnect.

I am adding a delimiter of #00 in my own code for a string end. ProcessData looks for this if not found will buffer data waiting for the next bit of data. If it is found we try and process the packet as a JSON string if it is valid then we process further.


Procedure TSmartDeviceDriver.FSendJSONMessage(var JSONMsg: TJSONObject; DeviceID : String);
var
  Count: Integer;
  SmartDevContext : TSmartDeviceConnection;
  SendString : String;
  iContextList : TList;
 
  
begin
  //Send a message to all by DeviceID := '';
  //Note this consumes the JSON Object!
  
  SendString := JSONMsg.ToString + #00;
  
  if JSONMsg <> nil then
    try
      iContextList := Self.FTCPServer.Contexts.LockList;
 
      for Count := 0 to iContextList.Count -1 do
      begin
        SmartDevContext := TSmartDeviceConnection(iContextList.Items[Count]);
 
        //Send message off to SmartDevice if Device ID's match
        if (SmartDevContext.FDeviceID = DeviceID) or (DeviceID = '') then
        try
          //Length(SendString);
 
          //Add the message to the Que for sending inside the Execute thread.
          SmartDevContext.FTXQueue.Add(SendString);
 
        except
 
        end;
 
      end;
 
    finally
      Self.FTCPServer.Contexts.UnlockList;
      
      //Finally Free the message "consumed!"
      JSONMsg.Free;
      JSONMsg := nil;
    end;
 
end;
 


I dont use a LF/LE because base64 encoding adds this every X number of characters(thats not useful... why does SOAP do that - is should be configurable, a different conversation... i want my base64 broken up or not)

Most of my JSON values are base64 encoded.


Procedure TSmartDeviceDriver.FSendJSONMessage(var JSONMsg: TJSONObject; DeviceID : String);
var
  Count: Integer;
  SmartDevContext : TSmartDeviceConnection;
  SendString : String;
  iContextList : TList;
 
  
begin
  //Send a message to all by DeviceID := '';
  //Note this consumes the JSON Object!
  
  SendString := JSONMsg.ToString + #00;
  
  if JSONMsg <> nil then
    try
      iContextList := Self.FTCPServer.Contexts.LockList;
 
      for Count := 0 to iContextList.Count -1 do
      begin
        SmartDevContext := TSmartDeviceConnection(iContextList.Items[Count]);
 
        //Send message off to SmartDevice if Device ID's match
        if (SmartDevContext.FDeviceID = DeviceID) or (DeviceID = '') then
        try
          //Length(SendString);
 
          //Add the message to the Que for sending inside the Execute thread.
          SmartDevContext.FTXQueue.Add(SendString);
 
        except
 
        end;
 
      end;
 
    finally
      Self.FTCPServer.Contexts.UnlockList;
      
      //Finally Free the message "consumed!"
      JSONMsg.Free;
      JSONMsg := nil;
    end;
 
end;
 


Note it is not my server communications that cause the AV, but from a third party, but suspect its something that I am not handling correctly.

From my logging of connects and disconnects I see I get multiple connects from one IP then when they disconnect the second Context that is when the AV occurs. I cant even replicate this with hacking tools myself with 1000's of threads in milliseconds.

Possibly wondering if the TJSONObject.Parse is messing memory up:

I use this code to detect EOL, this may be incorrect?

       
        EOLPos := Pos(#00, FBuffer,1);
 
        DataPacket := Copy(FBuffer,1,EOLPos-1);
        Delete(FBuffer,1,EOLPos);
 
        IncommingObject := TJSONObject.Create;
 
        //Check the JSON is valid
        if IncommingObject.Parse(BytesOf(UTF8String(DataPacket)),0) >= 0 then
        try
          //Process the JSON
        finally
          IncommingObject.Free;
        end;
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TidTCPServer AV when TCP port open to internet [Edit]  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 5:56 PM   in response to: Registered User in response to: Registered User
Registered User wrote:

I am definitely not manually adding any objects to the Contex list.
When I catch the error in the IDE i can see two identical memory
addresses in the context list - this is what is killing the server.

I'm telling you, that is phyically impossible. And TIdTCPServer has
been rock-solid for years and heavily tested.

I get a disconnect fired twice for same object

That is simply not possible. There is only one context object per
thread, and one thread per client. There is no overlap.

I am adding a delimiter of #00 in my own code for a string end.

OK. You were not accounting for that in the code you showed earlier.
In the example I gave you, simpy change the SendStr() and ReadStr()
method to this:

procedure TSmartDeviceConnection.SendStr(const S: String);
var
  Buf: TIdBytes;
begin
  Connection.IOHandler.Write(S+#0);
  FLastMsgSent := Ticks64;
end;
 
function TSmartDeviceConnection.ReadStr: String;
begin
  Result := Connection.IOHandler.ReadLn(#0);
  if Result <> '' then
    FLastMsgReceived := Ticks64;
end;


And DONT append #0 to the strings that you add to FTXQueue. Let
SendStr() add it later.

SendString := JSONMsg.ToString {+ #00};


ProcessData looks for this if not found will buffer data waiting for
the next bit of data.

The data you are buffering could already be corrupted due to the way
you are incorrectly reading strings from the InputBuffer before
ProcessData() even gets a change to see them.

Besides, Indy already does the buffering for you (that is why it has an
InputBuffer in the first place), you don't need to buffer the same data
manually. Just wait until the InputBuffer receives the delimiter, then
extract whole strings from the InputBuffer.

That is exactly what my previous example does, but it does so by
detecting inbound data and then blocking the calling thread when a
delimiter appears in the InputBuffer, if it isn't already. If you
don't want to block the calling thread, here is a slightly modified
example:

type
  TSmartDeviceConnection = class(TIdServerContext)
  public
    FTXQueue: TIdThreadSafeStringList;
    FLastMsgReceived,
    FLastMsgSent: TIdTicks;
    FBufferIndex: Integer;
    ...
 
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
 
    procedure SendStr(const S: String);
    function CheckForStr: String;
 
    procedure FPing;
 
    ...
  end;
 
constructor TSmartDeviceConnection.Create(AConnection:
TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited;
  FTXQueue := TIdThreadSafeStringList.Create;
  FLastMsgReceived := Ticks64;
  FLastMsgSent := FLastMsgReceived;
  FBufferIndex := 0;
  ...
end;
 
destructor TSmartDeviceConnection.Destroy;
begin
  FTXQueue.Free;
  inherited;
end;
 
procedure TSmartDeviceConnection.SendStr(const S: String);
var
  Buf: TIdBytes;
begin
  Connection.IOHandler.Write(S+#0);
  { alternatively:
  Connection.IOHandler.Write(S);
  Connection.IOHandler.Write(Byte($0));
  }
  FLastMsgSent := Ticks64;
end;
 
function TSmartDeviceConnection.CheckForStr: String;
var
  LIndex: Integer;
begin
  Result := '';
 
  LIndex := Connection.IOHandler.InputBuffer.IndexOf($0, FBufferIndex);
  if LIndex = -1 then
  begin
    FBufferIndex := Connection.IOHandler.InputBuffer.Size;
    Exit;
  end;
 
  Result := Connection.IOHandler.ReadString(LIndex);
  Connection.IOHandler.Discard(1);
  { alternatively:
  var Buf: TIdBytes;
  Connection.IOHandler.ReadBytes(Buf, LIndex+1);
  Result := IndyTextEncoding_UTF8.GetString(Buf, 0, LIndex);
  }
 
  LBufferIndex := 0;
 
  if Result <> '' then
    FLastMsgReceived := Ticks64;
end;
 
procedure TSmartDeviceConnection.FPing;
begin
  SendStr('PING');
end;
 
procedure TSmartDeviceDriver.FTCPServerConnect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.DefStringEncoding :=
IndyTextEncoding_UTF8;
  AContext.Connection.IOHandler.ReadTimeout := 5000;
end;
 
procedure TSmartDeviceDriver.FTCPServerExecute(AContext: TIdContext);
var
  Queue, TmpList: TStringList;
  IncommingStr: String;
  I: Integer;
  DeviceContext : TSmartDeviceConnection;
begin
  DeviceContext := AContext as TSmartDeviceConnection;
 
  if DeviceContext.FDisconnect then
  begin
    DeviceContext.Connection.Disconnect;
    Exit;
  end;
 
  tmpList := nil;
  try
    Queue := DeviceContext.FTXQueue.Lock;
    try
      if Queue.Count > 0 then
      begin
        TmpList := TStringList.Create;
        TmpList.Assign(Queue);
        Queue.Clear;
      end;
    finally
      DeviceContext.FTXQueue.Unlock;
    end;
 
    if TmpList <> nil then
    begin
      for I := 0 to TmpList.Count-1 do
      begin
        if DeviceContext.FDisconnect then
        begin
          DeviceContext.Connection.Disconnect;
          Exit;
        end;
        DeviceContext.SendStr(TmpList.Strings[I]);
      end;
    end;
  finally
    tmpList.Free;
  end;
 
  AContext.Connection.IOHandler.CheckForDataOnSource(10);
  AContext.Connection.IOHandler.CheckForDisconnect;
 
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    if DeviceContext.FDisconnect or
      (GetElapsedTicks(DeviceContext.FLastMsgReceived) >= 60000) then
    begin
      DeviceContext.Connection.Disconnect;
      Exit;
    end;
 
    if GetElapsedTicks(DeviceContext.FLastMsgSent) >= 30000 then
      DeviceContext.FPing;
 
    Exit;
  end;
 
  if DeviceContext.FDisconnect then
  begin
    DeviceContext.Connection.Disconnect;
    Exit;
  end;
 
  IncommingStr := DeviceContext.CheckForStr;
  if IncommingStr <> '' then
    DeviceContext.FProcessData(IncommingStr);
end;


I dont use a LF/LE because base64 encoding adds this every X number
of characters

No, base64 itself does not add any line breaks at all. Higher-level
formats, like MIME, that use base64 for encoding data will insert the
line breaks. That is an important distinction to make.

(thats not useful... why does SOAP do that - is should be
configurable, a different conversation... i want my base64 broken
up or not)

SOAP uses XML, not JSON. And since XML is self-describing and
self-delimiting, any line breaks found in base64 data is irrelevant and
can easily be discarded by any standards-compliant base64 parser (since
the base64 standard specifically states that characters not in the
base64 alphabet should be ignored), or manually if not using a
compliant parser.

Most of my JSON values are base64 encoded.

Why?

From my logging of connects and disconnects I see I get multiple
connects from one IP then when they disconnect the second Context
that is when the AV occurs.

and I'm telling you, it is not possible to have multiple connects share
the same context object. You are not debugging it correctly.

I cant even replicate this with hacking tools myself with 1000's of
threads in milliseconds.

Because it is not possible to happen in the first place.

Possibly wondering if the TJSONObject.Parse is messing memory up:

Doubtful.

I use this code to detect EOL, this may be incorrect?

You are not handling the case where Pos(#00) returns 0 when #00 has not
been received yet. If that happens, you shouldn't be doing anything
with the data at all, since it is not complete yet. Just add the new
data to the end of the buffer and move on to the I/O again.

On the other hand, the code I gave above avoids that issue, since it is
already doing all of the buffering for you. So you don't even need
your FBuffer variable anymore at all. The strings passed to
FProcessData() are complete strings.

Also, since the I/O code is already decoding the UTF-8 data to a
UnicodeString, there is no reason to convert it back to UTF-8 (let
alone a byte array) when parsing the JSON. Use
TJSONObject.ParseJSONValue() instead of TJSONObject.Parse().
ParseJSONValue() has an overload that takes a UnicodeString as input,
eg:

procedure TSmartDeviceConnection.FProcessData(const IncommingStr:
string);
var
  IncommingObject: TJSONObject;
begin
  IncommingObject := TJSONObject.ParseJSONValue(IncommingStr) as
TJSONObject;
  if IncommingObject <> nil then
  begin
    try
      //Process the JSON
    finally
      IncommingObject.Free;
    end;
  end;
end;


On a side note, you have a tendancy to misuse 'try/finally' blocks.
You like to initialize things inside the 'try' block that should be
initialized before the 'try' block instead.

For example:

try
  tmpList := nil;
  ...
finally
  tmpList.Free;
end;


Should be:

tmpList := nil;
try
  ...
finally
  tmpList.Free;
end;


And this:

Procedure TSmartDeviceDriver.FSendJSONMessage(var JSONMsg: TJSONObject;
DeviceID : String);
var
  ...
begin
  SendString := JSONMsg.ToString + #00;
  
  if JSONMsg <> nil then
    try
      iContextList := Self.FTCPServer.Contexts.LockList;
      ... 
    finally
      Self.FTCPServer.Contexts.UnlockList;
      
      //Finally Free the message "consumed!"
      JSONMsg.Free;
      JSONMsg := nil;
    end;
end;


Should be more like this:

Procedure TSmartDeviceDriver.FSendJSONMessage(var JSONMsg: TJSONObject;
DeviceID : String);
var
  ...
begin
  if JSONMsg <> nil then
  begin
    try
      SendString := JSONMsg.ToString;
    finally
      FreeAndNil(JSONMsg);
    end;
 
    iContextList := Self.FTCPServer.Contexts.LockList;
    try
      ... 
    finally
      Self.FTCPServer.Contexts.UnlockList;
    end;
  end;
end;


--
Remy Lebeau (TeamB)
Registered User

Posts: 46
Registered: 3/4/05
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 7:16 PM   in response to: Registered User in response to: Registered User
Thankyou Remmy

I will review your notes in detail and make the changes your recommend, i can only assume i am somehow corrupting something to get two identical contexts as memory addresses in the list. My stack ends up corrupted along the way.

I definitely need non blocking threads.

Can you advise of a base64 encoding function that doesent add the line breaks, wasnt able to find one in delphi base code.

If i could post screenshots i would show you the two identical memory addresses in the ContextList are there. I might dropbox them so you can see what i see. I will do this as i leave server running for a day or two.

At the moment i get the error 1-2 times per day maximum (only from 3rd party not from my own client)

I am using an if EOLPos > 0 then... i didn't show this, apologies.

I will post an update in a week or so and advise. (in middle of shifting country so not a huge amount of time to confirm tests). I have range checking on so thought any buffer overwrites would be picked up.

I use base64 for JSON values as i am unable to send large binary files easily. Sure I can pack as a JSON array, but size is then constrained to maximum size of the array (unable to transfer larger files in practice). I am using this in a large project that has been in production for 2 years, it works well and it suits my purpose for now, where databases and datasnap do not afford flexibility ( or reliability - datasnap). JSON allows manipulation of datapoints and saves significant time for prototyping where we use key:value pairs rather than a field value: fieldtype: data as with traditional databases for this portion of our project.
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 8:01 PM   in response to: Registered User in response to: Registered User
Registered User wrote:

Can you advise of a base64 encoding function that doesent add the
line breaks, wasnt able to find one in delphi base code.

Look at Indy's own TIdEncoderMIME class. That is Indy's built-in
base64 encoder.

If i could post screenshots i would show you the two identical memory
addresses in the ContextList are there.

This server has an "Attachments" forum.

I use base64 for JSON values as i am unable to send large binary
files easily.

Are you sending JSON inside of SOAP? Or are you sending JSON directly?
Indy handles large binary transfers just fine. Besides, base64
increases a data's encoded size by 1 1/3 times anyway, so it is
certainly not helping your size issue.

Sure I can pack as a JSON array, but size is then constrained to
maximum size of the array (unable to transfer larger files in
practice).

Why? What does array sizes have to do with anything? Are you sending
only 1 array per transfer, or are you breaking up large data into
multiple arrays? TCP is a byte stream, it doesn't care how many arrays
you send.

--
Remy Lebeau (TeamB)
Registered User

Posts: 46
Registered: 3/4/05
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 8:10 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Thanks Remmy.

ok i have found that i can manually kill the TCP Context with an AV at the postioned first mentioned when parsing invalid JSON via "parse" (just a random string withe the terminator will do it with my code). interestingly the parse does not raise an error and it thinks that its ok. It looks like call stack is overwritten somehow.

I will dig deeper into that and advise.

I am using a raw JSON message no soap - I have a look at the Mime encoding from indy.
Registered User

Posts: 46
Registered: 3/4/05
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 8:24 PM   in response to: Registered User in response to: Registered User
Registered User wrote:
Thanks Remmy.

ok i have found that i can manually kill the TCP Context with an AV at the postioned first mentioned when parsing invalid JSON via "parse" (just a random string withe the terminator will do it with my code). interestingly the parse does not raise an error and it thinks that its ok. It looks like call stack is overwritten somehow.

I will dig deeper into that and advise.

I am using a raw JSON message no soap - I have a look at the Mime encoding from indy.

Ok found the issue parse returns ok even with non valid JSON I was freeing a result object that had not been initialized as i was expecting a result object. This was freeing something that didnt exist and slaying the call stack. I set the value to nil so i can check it and now its working as intended, no AV in the IOhandler. I run this on the internet and see if hackers slay my server :)

Thankyou for your assistance Remmy. I will look to implement your recommendations.
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 8:28 PM   in response to: Registered User in response to: Registered User
Registered User wrote:

ok i have found that i can manually kill the TCP Context with an AV
at the postioned first mentioned when parsing invalid JSON via
"parse" (just a random string withe the terminator will do it with my
code).

The JSON parser should not raise an exception (let alone an
AccessViolation) on malformed JSON data, it should simply fail and
return false/nil. If that is not the case, then the parser is buggy,
use a different one. There are plenty of 3rd party JSON parsers
available for Delphi.

interestingly the parse does not raise an error and it thinks
that its ok. It looks like call stack is overwritten somehow.

Did you switch from TJSONObject.Parse() to
TJSONObject.ParseJSONValue(), like I suggested?

I am using a raw JSON message no soap

Then you definately should not be encoding your JSON with base64.
There is no good reason to do that.

--
Remy Lebeau (TeamB)
Registered User

Posts: 46
Registered: 3/4/05
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 24, 2017 10:07 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Hi Remmy

IncommingObject := TJSONObject.ParseJSONValue(DataPacket, False) as TJSONObject;
   if IncommingObject <> nil then


Have implemented your Code for this which seems to give a better confirmation that at least I have a JSON object to work with.

You are correct there is no reason to use Base64 forJSON, however I found this to be a suitable workaround to DS issues and other limitations as i progressed in development and prototyping. Hopefully this explains:

Using Base64 encoding i found I could send a single packet that has characters outside of printable range. If not i found Datasnap would fail miserably if sending a jpeg for instance or a quoted string, the built in delphi JSON parser didnt escape characters properly if i had "" characters i think - all i recall was that it was a mess to work with datasnap and trying to send JSON messages as a variable in a stored procedure, base64 solved this as data-snap didnt worry about the data contents then. (back with XE4 datasnap was very broken, could not load a JPEG from a database without a crash, that was fixed in later versions but i had to work with it then and there, right now its not good with poor wifi if i use out of the box and have had to modify EMB source to prevent hangs - loading a database with real world Wifi connection with data-snap or using callbacks - DS client will hang forever on readchar if a tunnel is closed by the server.

Secondly if sending a large JSON value as an array of characters, the array size was limited (talking millions of elements, size of Integer i think it was) and would get an "EOutOfMemory" error if sending a packet larger than ~1.3MB or something, I have capped my jpegs at 10MB in size now with base64 and dont get errors - i am happy, if for no other reason than it functions. There may be other ways of doing this but Base64 encoding I found to work and not cause data-snap or internal JSON array errors and saved having to break up packets which leads to additional processing code complexity.

I like JSON as it moves my payloads in a format that's easy to debug and read and its consistent.

Im certain there are other ways of achieving the same, but I worked with what I had and what solved the problems at hand in a commercial time frame and now have a reliable platform.

Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 28, 2017 11:20 AM   in response to: Registered User in response to: Registered User
Registered User wrote:

Using Base64 encoding i found I could send a single packet that has
characters outside of printable range.

MIME's quoted-printable encoding, or even url-encoding, would have been
less intrusive and more human-readable, while not bloating the data
size as much as base64 does. Just saying...

Secondly if sending a large JSON value as an array of characters, the
array size was limited (talking millions of elements, size of Integer
i think it was) and would get an "EOutOfMemory" error if sending a
packet larger than ~1.3MB or something, I have capped my jpegs at
10MB in size now with base64 and dont get errors - i am happy, if for
no other reason than it functions.

Arrays are capable of going up to billions of elements, not mere
millions, as long as you have sufficient contigious memory to hold
the array data.

--
Remy Lebeau (TeamB)
Registered User

Posts: 46
Registered: 3/4/05
Re: TidTCPServer AV when TCP port open to internet  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 28, 2017 4:09 PM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...
Thanks Remmy

Ill be sure to look into MIME.
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02