mORMot Open Source

Quorren

Member

Registered: 2016-10-03

Posts: 14

SynCrtSock TAsynchConnection hang up. Bug?

Hi ab. I am trying to use TAsynchServer from SynCrtSock.
I start my test application with event "OnRead" filled with "Sender.Write(self,'Hello!');"  and it hangs when i am trying to write using telnet.
Steps to reproduce
1. start application
2. open telnet session with "telnet 127.0.0.1 333"
3. write something. You have to get "Hello!" as responce.

Application code

program SocketTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  mormot,
  SynCrtSock,
  SynBidirSock;

type
TMySocket = class(TAsynchConnection)
public
function OnRead(Sender: TAsynchConnections): TPollAsynchSocketOnRead; override;
end;

var
Server:TAsynchServer;

{ TMySocket }

function TMySocket.OnRead(Sender: TAsynchConnections): TPollAsynchSocketOnRead;
begin
Sender.Write(self,'Hello!');
end;

begin
  try
  Server:=TAsynchServer.Create('333',nil,nil,TMySocket,'test',TSQLLog, [] ,50);
  Readln(Input);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

i think the problem is "procedure TPollAsynchSockets.ProcessRead(timeoutMS: integer);"
i just moved block

          if added>0 then
            try
              inc(fReadCount);
              inc(fReadBytes,added);
              if OnRead(connection)=sorClose then
                CloseConnection;
            except
              CloseConnection; // any exception will force socket shutdown
            end;

after

        finally
          slot.UnLock;
        end;

and everything become good)

procedure TPollAsynchSockets.ProcessRead(timeoutMS: integer);
var notif: TPollSocketResult;
    connection: TObject;
    slot: PPollSocketsSlot;
    res,added: integer;
    temp: array[0..$7fff] of byte; // read up to 32KB chunks
  procedure CloseConnection;
  begin
    if connection=nil then
      exit;
    Stop(connection); // will shutdown the socket
    try
      OnClose(connection); // do connection.Free
    except
      connection := nil;
    end;
    slot := nil; // ignore pseClosed
  end;
begin
  if (self=nil) or fRead.Terminated then
    exit;
  InterlockedIncrement(fProcessing);
  try
    if not fRead.GetOne(timeoutMS,notif) then
      exit;
    connection := TObject(notif.tag);
    slot := SlotFromConnection(connection);
    if (slot=nil) or (slot.socket=0) then
      exit;
    if pseError in notif.events then
      if not OnError(connection,notif.events) then begin // false = shutdown
        CloseConnection;
        exit;
      end;
    if pseRead in notif.events then begin
      if slot.Lock then // ensure read slot not already processed in another thread
        try
          added := 0;
          repeat
            if fRead.Terminated then
              exit;
            res := AsynchRecv(slot.socket,@temp,sizeof(temp));
            if res<0 then       // error - probably "may block"
              break;
            if res=0 then begin // socket closed -> abort
              CloseConnection;
              exit;
            end;
            AppendData(slot.readbuf,temp,res);
            inc(added,res);
          until false;
//          if added>0 then
//            try
//              inc(fReadCount);
//              inc(fReadBytes,added);
//              if OnRead(connection)=sorClose then
//                CloseConnection;
//            except
//              CloseConnection; // any exception will force socket shutdown
//            end;
        finally
          slot.UnLock;
        end;
          if added>0 then
            try
              inc(fReadCount);
              inc(fReadBytes,added);
              if OnRead(connection)=sorClose then
                CloseConnection;
            except
              CloseConnection; // any exception will force socket shutdown
            end;
    end;
    if (slot<>nil) and (pseClosed in notif.events) then begin
      CloseConnection;
      exit;
    end;
  finally
    InterlockedDecrement(fProcessing);
  end;
end;

Last edited by Quorren (2018-03-14 20:01:19)

franfj

Member

Registered: 2018-03-28

Posts: 12

Re: SynCrtSock TAsynchConnection hang up. Bug?

Same issue here.

Write works if called anywhere outside of OnRead, but if used inside as documentation suggest it hangs and no write is performed.

I'm trying a simple "echo" program:

function TMyTCPConnection.OnRead(Sender: TAsynchConnections): TPollAsynchSocketOnRead;
var
  aLineEnd : Boolean;
  sendStr: SockString;
begin
  result := sorContinue;
  aLineEnd := Pos(#10,fSlot.readbuf)>0;
  fLastFullLine := fLastFullLine + fSlot.readbuf;
  fSlot.readbuf := '';
  if aLineEnd then
  begin
    sendStr :='Received: '+ fLastFullLine;
    fLastFullLine := '';
    Sender.Write(self,sendStr);
  end;
end;