Delphi: Multithreading, Thread safe not working

Question

When data is sending to "tunnel" socket, it's sometimes merged, implemented the Critical Section but it's not working..

What I'm doing wrong ?

type
  my_ff_thread = class;
  my_ss_thread = class;
  Tmy_tunnel_from_MappedPortTCP = class;


  Tmy_thread_list = class
      ff_id   : string;
      ff_connection : TIdTCPConnection;
      constructor Create(local_ff_id: string; local_ss_c: TIdTCPConnection);
  end;


  Tmy_tunnel_from_MappedPortTCP = class(TIdBaseComponent)
  protected
    procedure InitComponent; override;
  public
    function my_connect:boolean;
  end;


  my_ff_thread = class(TThread)
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;


  my_ss_thread = class(TThread)
  protected
    Fff_id : string;
    Fff_cmd : string;
    Fff_data : TIdBytes;
    procedure Execute; override;
  public
    constructor Create(ff_id:string; ff_cmd:string; ff_data:TIdBytes);
    function prepare_cmd(cmd:string; id:string; data:string):string;
    function set_nulls_at_begin(s:string):string;
  end;


var my_list : TThreadList;
    CS: TRTLCriticalSection;
    tunnel: TIdTCPConnection;

Implementation



constructor my_ff_thread.Create;
begin
  inherited Create(True);
end;




constructor my_ss_thread.Create(ff_id:string; ff_cmd:string; ff_data:TIdBytes);
begin
  inherited Create(True);
  Fff_id := ff_id;
  Fff_cmd := ff_cmd;
  Fff_data := ff_data;
end;


constructor Tmy_thread_list.Create(local_ff_id: string; local_ss_c: TIdTCPConnection);
begin
  ff_id   := local_ff_id;
  ff_connection := local_ss_c;
end;





function my_ss_thread.set_nulls_at_begin(s:string):string;
var len, i : integer;
    res : string;
begin
  if s='' then
  begin
    Result := '';
    Exit;
  end;
  res := '';
  len := Length(s);
  if len < 10 then
    for i:=1 to (10 - len) do
    begin
      res := res + '0';
    end;
  Result := res + s;
end;




function my_ss_thread.prepare_cmd(cmd:string; id:string; data:string):string;
var
  packet : string;
begin
  packet := set_nulls_at_begin(IntToStr(Length(cmd))) + cmd;
  packet := packet + set_nulls_at_begin(IntToStr(Length(id))) + id;
  packet := packet + set_nulls_at_begin(IntToStr(Length(data))) + data;
  Result := packet;
end;








function del_ff_from_list(firefox_id:string):boolean;
var i : integer;
begin
  Result := True;
  try
    with my_list.LockList do
    begin
      for i:=0 to Count-1 do
      begin
        if Tmy_thread_list(Items[i]).ff_id = firefox_id then
        begin
          Delete(i);
          break;
        end;
      end;
    end;
  finally
    my_list.UnlockList;
  end;
end;




procedure my_ss_thread.Execute;
var ss : TIdTCPClient;
    unix_time : integer;
    data : TIdBytes;
    packet : string;
    packet_stream: TStringStream;
begin
    ss := TIdTCPClient.Create(nil);
    try
      with TIdTcpClient(ss) do
      begin
        Host := '127.0.0.1';
        Port := 6666;
        ReadTimeout := 1000 * 5;
        Connect;
      end;
    except
      on E:Exception do
      begin
        ss.Disconnect;
        exit;
      end;
    end;





    try
      my_list.LockList.Add(Tmy_thread_list.Create(Fff_id, ss));
    finally
      my_list.UnlockList;
    end;

    try
      ss.Socket.Write(Fff_data);
    except
      on E:Exception do begin {Fmy_memo.Lines.Add('First data not sent!');} end;
    end;


    unix_time := DateTimeToUnix(NOW);


    while True do
    begin
      ss.Socket.CheckForDataOnSource(5);
      if not ss.Socket.InputBufferIsEmpty then
      begin
        SetLength(data, 0);

        ss.Socket.InputBuffer.ExtractToBytes(data);
        packet := prepare_cmd('data_from_ss', Fff_id, TIdEncoderMIME.EncodeBytes(data));
        packet_stream := TStringStream.Create(packet);
        packet_stream.Position := 0;

        ss.Socket.InputBuffer.Clear;
        unix_time := DateTimeToUnix(NOW);

        try
            EnterCriticalSection(CS);
            tunnel.Socket.Write(packet_stream, -1, True);
            LeaveCriticalSection(CS);

        except
          on E:Exception do
          begin
          end;
        end;
      end;


      if (DateTimeToUnix(NOW) - unix_time) > 120 then
      begin
        ss.Disconnect;
        break;
      end;

      if not ss.Connected then
      begin
        break;
      end;

      if not tunnel.Connected then
      begin
        ss.Disconnect;
        break;
      end;


    end;


    try
      if tunnel.Connected then
      begin
        EnterCriticalSection(CS);
          packet := prepare_cmd('disconnect', Fff_id, 'x');
          packet_stream := TStringStream.Create(packet);
          packet_stream.Position := 0;
          tunnel.Socket.Write(packet_stream, -1, True);
        LeaveCriticalSection(CS);
      end;
    except
      on E:Exception do begin end;
    end;


Terminate;
end;










procedure my_ff_thread.Execute;
var
  t : my_ss_thread;
  cmd, id : string;
  i : integer;
  found_ss : TIdTCPConnection;
  list : TList;
  packet : string;
  cmd_len, id_len, data_len : integer;
  data : TIdBytes;
  orig_data : string;
  packet_stream: TStringStream;
  cmd_len_str, id_len_str, data_len_str : string;
begin
  packet_stream := TStringStream.Create;

  while not Terminated do
  begin
        packet_stream.Position := 0;
        try
          tunnel.Socket.ReadStream(packet_stream);
        except
          on E:Exception do begin end;
        end;

        packet := packet_stream.DataString;


        if packet = '0000' then
          continue;




        try
        cmd_len_str := Copy(packet, 1, 10);
        cmd_len := StrToInt(cmd_len_str);
        except
          on E:Exception do begin end;
        end;
        Delete(packet, 1, 10);
        cmd := Copy(packet, 1, cmd_len);
        Delete(packet, 1, cmd_len);

        try
        id_len_str := Copy(packet, 1, 10);
        id_len := StrToInt(id_len_str);
        except
          on E:Exception do begin end;
        end;
        Delete(packet, 1, 10);
        id := Copy(packet, 1, id_len);
        Delete(packet, 1, id_len);

        SetLength(data, 0);
        try
        data_len_str := Copy(packet, 1, 10);
        data_len := StrToInt(data_len_str);
        except
          on E:Exception do begin end;
        end;
        Delete(packet, 1, 10);
        data := TIdDecoderMIME.DecodeBytes(Copy(packet, 1, data_len));
        orig_data := Copy(packet, 1, data_len);
        Delete(packet, 1, data_len);

        found_ss := nil;
        try
          list := my_list.LockList;
          for i:=0 to list.Count-1 do
          begin
            if Tmy_thread_list(list[i]).ff_id = id then
            begin
              found_ss := Tmy_thread_list(list[i]).ff_connection;
              break;
            end;
          end;
        finally
          my_list.UnlockList;
        end;


        if cmd = 'disconnect' then
        begin
          if found_ss <> nil then
            if found_ss.Connected then
            begin
              found_ss.Disconnect;
              del_ff_from_list(id);
              continue;
            end;
        end;


        if found_ss = nil then
        begin
          t := my_ss_thread.Create(id, cmd, data);
          t.Start;
        end
        else
        begin
          if found_ss <> nil then
            try
            if found_ss.Connected then
              begin
                found_ss.Socket.Write(data);
              end;
            except
              on E:Exception do begin end;
            end;
        end;




      if not tunnel.Connected then
      begin
        Terminate;
        break;
      end;


  end;

end;



function Tmy_tunnel_from_MappedPortTCP.my_connect:boolean;
var t : my_ff_thread;
begin
  Result := True;
    try
      with TIdTcpClient(tunnel) do
      begin
        Host := '192.168.0.157';
        Port := 8099;
        Connect;
      end;
    except
      on E:Exception do
      begin
        tunnel.Disconnect;
        exit;
      end;
    end;
    t := my_ff_thread.Create;
    t.Start;

end;


initialization
  InitializeCriticalSection(CS);
  my_list := TThreadList.Create;
  tunnel := TIdTCPClient.Create(nil);
finalization
  DeleteCriticalSection(CS);


end.

Well, straight off, if s is of length 10 then 'set_nulls_at_begin' returns just s, ie length 10. If s is of length 9, the loop runs from 1 to (10-9), ie. 1 to 2, so res is "00" and the result returned is of length 11. — Martin James, Dec 15 '11 at 00:22
In your class `my_ss_thread.Create` the `ff_data` is not deep copied into your Fff_data. TIdBytes is declared as `array of byte`. See here [how-to-copy-array](http://stackoverflow.com/questions/1119215/how-to-copy-array). — LU RD, Dec 15 '11 at 00:39
I would use `StringOfChar()` instead, ie: `if Length(s) < 10 then Result := StringOfChar('0', 10-Length(s)) + s else Result := s;` This is especially important to do if `s` is blank, as `set_nulls_at_begin()` would then return a blank string instead of returning `'0000000000'`. — Remy Lebeau, Dec 15 '11 at 00:43
all is ok with set_nuls_at_begin, here is screenshot http://img502.imageshack.us/img502/5646/allok.jpg — jmp, Dec 15 '11 at 00:52
@RemyLebeau-TeamB do you mean this line? data := TIdDecoderMIME.DecodeBytes(Copy(packet, 1, data_len)); , or this: Copy(packet, 1, data_len) , because Copy() is copying the base64 string. — jmp, Dec 15 '11 at 01:13
Since you are sending a base64 string, you have to decode it to get the original raw bytes. I would assign `orig_data` first (since that statement is just copying the base64 string) and then call `data := TIdDecoderMIME.DecodeBytes(orig_data)`, no need to call Copy() twice to extract the same string value. — Remy Lebeau, Dec 15 '11 at 02:03

Remy Lebeau · Accepted Answer · 2011-12-15T03:29:03.823

Try something like this:

type 
  my_ff_thread = class; 
  my_ss_thread = class; 
  Tmy_tunnel_from_MappedPortTCP = class; 

  Tmy_thread_list = class 
  public
    ff_id   : string; 
    ff_connection : TIdTCPConnection; 
    constructor Create(const local_ff_id: string; local_ss_c: TIdTCPConnection); 
  end; 

  Tmy_tunnel_from_MappedPortTCP = class(TIdBaseComponent) 
  protected 
    procedure InitComponent; override; 
  public 
    function my_connect: boolean; 
    function my_disconnect: boolean; 
  end; 

  my_ff_thread = class(TThread) 
  protected 
    procedure Execute; override; 
  public 
    constructor Create;
  end; 

  my_ss_thread = class(TThread) 
  protected 
    Fff_id : string; 
    Fff_cmd : string; 
    Fff_data : TIdBytes; 
    procedure Execute; override; 
  public 
    constructor Create(const ff_id, ff_cmd: string; const ff_data: TIdBytes); 
  end; 

var
  my_list : TThreadList = nil; 
  CS: TCriticalSection = nil; 
  tunnel: TIdTCPClient = nil; 
  tunnel_thread: my_ff_thread = nil;

implementation 

constructor Tmy_thread_list.Create(const local_ff_id: string; local_ss_c: TIdTCPConnection); 
begin 
  ff_id := local_ff_id; 
  ff_connection := local_ss_c; 
end; 

constructor my_ss_thread.Create(const ff_id, ff_cmd: string; const ff_data: TIdBytes); 
begin 
  inherited Create(False); 
  Fff_id   := ff_id; 
  Fff_cmd  := ff_cmd; 
  Fff_data := Copy(ff_data, 0, Length(ff_data)); 
end; 

procedure my_ss_thread.Execute; 
var
  ss : TIdTCPClient; 
  data : TIdBytes; 
  packet : string;

  procedure WriteStrToStream(strm: TStream; const s: String);
  var
    buf: TIdBytes;
    len: Integer;
  begin
    buf := ToBytes(s, IndyUTF8Encoding);
    len := Length(buf);
    strm.WriteBuffer(len, SizeOf(Integer));
    if bytes <> nil then
      strm.WriteBuffer(buf[0], len);
  end;

  procedure WritePacketToTunnel(const cmd: string; const bytes: TIdBytes = nil);
  var
    strm: TMemoryStream;
  begin
    strm := TMemoryStream.Create;
    try
      WriteStrToStream(strm, cmd);
      WriteStrToStream(strm, Fff_id);
      WriteStrToStream(strm, TIdEncoderMIME.EncodeBytes(bytes));

      CS.Enter;
      try 
        tunnel.IOHandler.Write(strm, 0, True);
      finally
        CS.Leave;
      end;
    finally
      strm.Free;
    end;
  end;

begin 
  ss := TIdTCPClient.Create(nil); 
  try
    ss.Host := '127.0.0.1'; 
    ss.Port := 6666; 
    ss.ReadTimeout := 1000 * 120; 

    ss.Connect; 
    try  
      my_list.Add(Tmy_thread_list.Create(Fff_id, ss)); 

      try 
        ss.IOHandler.Write(Fff_data); 
      except 
        {Fmy_memo.Lines.Add('First data not sent!');}
        raise;
      end; 

      while not Terminated do 
      begin 
        SetLength(data, 0); 
        ss.IOHandler.ReadBytes(data, -1);
        if Length(data) = 0 then
          break;

        WritePacketToTunnel('data_from_ss', data);
      end; 

      WritePacketToTunnel('disconnect');
    finally
      ss.Disconnect;
    end;
  finally
    ss.Free;
  end;
end; 

constructor my_ff_thread.Create; 
begin 
  inherited Create(False); 
end; 

procedure my_ff_thread.Execute; 
var 
  cmd, id : string; 
  data : TIdBytes; 
  i : integer; 
  found_ss : TIdTCPConnection; 
  list : TList; 

  function ReadStrFromStream(strm: TStream): string;
  var
    len: Integer;
  begin
    strm.ReadBuffer(len, SizeOf(Integer));
    if len > 0 then
      Result := IdGlobal.ReadStringFromStream(strm, len, IndyUTF8Encoding)
    else
      Result := '';
  end;

  procedure ReadPacketFromTunnel(var v_cmd, v_id: string; var v_data: TIdBytes);
  var
    strm: TMemoryStream;
  begin
    strm := TMemoryStream.Create;
    try
      tunnel.IOHandler.ReadStream(strm, -1, False);
      strm.Position := 0;
      v_cmd  := ReadStrFromStream(strm);
      v_id   := ReadStrFromStream(strm);
      v_data := TIdDecoderMIME.DecodeBytes(ReadStrFromStream(strm));
    finally
      strm.Free;
    end;
  end;

begin 
  while not Terminated do 
  begin 
    ReadPacketFromTunnel(cmd, id, data); 

    found_ss := nil; 
    list := my_list.LockList; 
    try 
      for i := 0 to list.Count-1 do 
      begin 
        if Tmy_thread_list(list[i]).ff_id = id then 
        begin 
          found_ss := Tmy_thread_list(list[i]).ff_connection; 
          break; 
        end; 
      end; 
    finally 
      my_list.UnlockList; 
    end; 

    if cmd = 'disconnect' then 
    begin 
      if found_ss <> nil then
        found_ss.Disconnect; 
      del_ff_from_list(id); 
      continue; 
    end; 

    if found_ss <> nil then 
    begin 
      try 
        found_ss.IOHandler.Write(data); 
      except 
      end; 
      Continue;
    end;

    my_ss_thread.Create(id, cmd, data);
  end; 
end; 

function Tmy_tunnel_from_MappedPortTCP.my_connect: boolean; 
begin 
  Result := True; 
  try 
    tunnel.Host := '192.168.0.157'; 
    tunnel.Port := 8099; 
    tunnel.Connect; 
    tunnel_thread := my_ff_thread.Create(tunnel); 
  except 
    tunnel.Disconnect; 
    Result := False;
  end; 
end; 

function Tmy_tunnel_from_MappedPortTCP.my_disconnect: boolean; 
begin 
  Result := True; 
  try
    if tunnel_thread <> nil then tunnel_thread.Terminate;
    try
      tunnel.Disconnect; 
    finally
      if tunnel_thread <> nil then
      begin
        tunnel_thread.WaitFor;
        FreeAnNil(tunnel_thread);
      end;
    end;
  except 
    Result := False;
  end; 
end; 

initialization 
  CS := TCriticalSection.Create; 
  my_list := TThreadList.Create; 
  tunnel := TIdTCPClient.Create(nil); 
finalization 
  tunnel.Free; 
  my_list.Free; 
  CS.Free; 

end.

If `IndyUTF8Encoding()` does not compile for you, then you are using an outdated version of Indy. `IndyUTF8Encoding()` exists in the current version, and was introduced awhile ago to work around a bug in Embarcadero's `TEncoding.UTF8` implementation (`TIdTextEncoding` is an alias for `TEncoding` in D2009+). — Remy Lebeau, Dec 15 '11 at 03:14
Renamed function ReadStringFromStream(strm: TStream): string; to my_ReadStringFromStream, because it's already defined in IOHandler — jmp, Dec 15 '11 at 03:16
was a little bug in WriteStringToStream , vars: buf & bytes, replaced: bytesvar with buf — jmp, Dec 15 '11 at 03:25
Updated the indy to svn ver. Q: Is it thread safe to my_list.Add() to TThreadList without locking ? — jmp, Dec 15 '11 at 05:24
Yes, TThreadList.Add() is thread-safe. It locks/unlocks the list internally. Again, please use a packet sniffer to see whether the client sending code or the server reading code is actually at fault. Until you do that, we are just going around in circles. If you see the merged data being transmitted, then the client is at fault and the CS is not working correctly. If the transmitted code is clean, then the server reading code is at fault instead. — Remy Lebeau, Dec 15 '11 at 18:42
BTW, in your earlier code snippets, you were calling the `Connected()` method across thread boundaries. DO NOT do that. `Connected()` performs a read internally, which can cause exactly this type of data corruption when other threads are reading at the same time. That's why I took out all of the `Connected()` calls in my examples. Indy will raise an exception if you try to access a disconnected socket, so I modeled my examples to account for that fact. — Remy Lebeau, Dec 15 '11 at 18:43
that was the problem, Connected() eated bytes from stream!! So many days spent, and finally found the problem! Thanks. Biggest Xmas present from you to me!! big thx!! Happy Christmas & New year! — jmp, Dec 15 '11 at 20:46

Delphi: Multithreading, Thread safe not working

1 Answers1