[SOLVED] Access violations in simple program
lazarus / 1-Linux

----------------------------------------------------------------------
BigChimp · 2014-07-17 14:40

I'm trying to write a daemon-like application that periodically
connects to a router and gets some statistics, then saves them in a
database.
Had started with fpTimer but saw access violations so tried to
simplify things.

On my dev machine (Debian unstable x64 VM, FPC trunk), things go fine.
On my production machine (Debian testing x64), the program runs,
inserts data (so the connecting/db stuff seems ok) but in the loop it
sometimes (well, who knows, always, if you wait long enough) stops
with an access violation.

Is it me or FPC?  As usual, I might be forgetting something painfully
obvious...
(Using trunk, for debugging with -g -gw2 -O-1, but have tried with
2.6.x as well no difference; have also tried compiling without -g -gw2
-O-1 but no difference).

This time, first run bombs; seconds bombs after second job called
(second job did insert records into database).

Code: [Select]reinier@myserver:~$ ./netboss
15:28:53: ready to call job
15:29:02: job called
15:29:02: sleeping 20 seconds
Main loop error: exception message: Access violation
reinier@myserver:~$ ./netboss
15:29:14: ready to call job
15:29:22: job called
15:29:22: sleeping 20 seconds
15:29:42: sleeping 20 seconds
15:30:02: sleeping 20 seconds
15:30:22: sleeping 20 seconds
15:30:42: sleeping 20 seconds
...
15:59:08: sleeping 20 seconds
15:59:28: ready to call job
15:59:34: job called
15:59:34: sleeping 20 seconds
Main loop error: exception message: Access violation
(I don't understand either why the job wasn't called at about 15:45
given that I set the wait time to be 15 minutes in code but I've never
been good with date/time calculations  )

Source code below, compiled with debug mode, replaced some passwords
etc with dummies.
FYI: on Windows, I use Synapse (where it seems to work fine); on *nix,
I call the ssh executable to run my commands.

Code: [Select]program netboss;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  {$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}
  {$ENDIF}
  Classes,
  SysUtils,
  processutils,
  {$ifdef unix}
  opensshwrapper,
  {$endif}
  {$ifdef mswindows}
  ClientSSH2,
  {$endif}
  sqldb,
  IBConnection,
  strutils;

{
Firebird database:
CREATE TABLE CONNECTIONS
(
  ID INTEGER NOT NULL,
  PROTOCOL VARCHAR(10),
  LOCALHOST VARCHAR(255),
  LOCALPORT VARCHAR(15) CHARACTER SET NONE,
  REMOTEHOST VARCHAR(255),
  REMOTEPORT VARCHAR(15) CHARACTER SET NONE,
  WHENCONNECTED TIMESTAMP,
  CONSTRAINT CONNECTIONS_PK_1 PRIMARY KEY (ID)
);

GRANT DELETE, INSERT, REFERENCES, SELECT, UPDATE
 ON CONNECTIONS TO  SYSDBA WITH GRANT OPTION;


SET TERM ^ ;
CREATE TRIGGER CONNECTIONS_ID_GEN FOR CONNECTIONS ACTIVE
BEFORE INSERT POSITION 0
AS BEGIN


IF (NEW.ID IS NULL OR NEW.ID = 0) THEN


  NEW.ID = GEN_ID(connections_ID_Gen, 1);


END^
SET TERM ; ^

}

type
  THostType = (htLinux, htSpeedTouch, htWindows);
  { TWorkerClass }

  TWorkerClass = class(TObject)
  private
    FObfuscKey: string; //obfuscation key; please modify in your
confidential.inc
    FDBServer: string;
    FDBUser: string;
    FDBPassword: string;
    FDBDatabase: string;
    FPrivateKeyFile: string;
    //Private key for SSH communication. Assumes key is same for all
devices...
    FFSServerHostType: THostType;
    FFSServerIP: string;
    //Router IP address; should be user customisable
    FFSServerPort: integer; //Port to use for ssh access
    FFSServerUser: string; //Username for ssh/telnet access to local
router
  public
    // Runs actual job; if TFTPTimer were used, Sender would be
needed.
    procedure TimerCalled(Sender: TObject);
    constructor Create;
    destructor Destroy; override;
  end;

  { TWorkerClass }

  constructor TWorkerClass.Create;
  begin
    try
      FFSServerHostType := htLinux; //our router is linux
      // User customization - this file should be protected
      // If you hit compile errors here, please copy
confidential_sample.inc to confidential.inc
      // and adjust contents to match your passwords etc
      {$include confidential.inc}

      // Try to find private key in application directory or ~/ssh/ or
home folder
      if not(FileExists(FPrivateKeyFile)) then
        FPrivateKeyFile:=IncludeTrailingPathDelimiter(ExtractFilePath(
ParamStr(0)))+ExtractFileName(FPrivateKeyFile);
      if not(FileExists(FPrivateKeyFile)) then
        FPrivateKeyFile:=IncludeTrailingPathDelimiter(ExpandFileName('
~/.ssh'))+ExtractFileName(FPrivateKeyFile);
      if not(FileExists(FPrivateKeyFile)) then
        FPrivateKeyFile:=IncludeTrailingPathDelimiter(ExpandFileName('
~'))+ExtractFileName(FPrivateKeyFile);

      if (FPrivateKeyFile <> '') and (not fileexists(FPrivateKeyFile))
then
        raise Exception.CreateFmt('Private key file %s not found.
Aborting.',[FPrivateKeyFile]);

      //todo: check permissions for private key are correct: go-rwx
    except
      on E: Exception do
      begin
        writeln('TWorkerClass.Create: error: exception '+E.Message);
        halt(128);
      end;
    end;
  end;

  destructor TWorkerClass.Destroy;
  begin
    inherited Destroy;
  end;


  procedure TWorkerClass.TimerCalled(Sender: TObject);
  var
    {$ifdef mswindows}
    SSHClient: TTelnetSSHClient;
    {$else}
    SSHClient: TOpenSSH;
    {$endif}
    DBConnection: TIBConnection;
    InsertQuery: TSQLQuery;
    NatOutput: TStringList;
    NetstatOutput: TStringList; //output from netstat
    LastErrorText: string;
    Transaction: TSQLTransaction;
    WhenRun: TDateTime;
    i: integer;
  begin
    NatOutput:=TStringList.Create;
    NetstatOutput:=TStringList.Create;
    DBConnection := TIBConnection.Create(nil);
    Transaction:=TSQLTransaction.Create(nil);
    InsertQuery:=TSQLQuery.Create(nil);
    {$ifdef mswindows}
    SSHClient := TTelnetSSHClient.Create;
    {$else}
    SSHClient := TOpenSSH.Create;
    {$endif}
    try
      try
        SSHClient.HostName := FFSServerIP;
        SSHClient.Port := IntToStr(FFSServerPort);
        SSHClient.UserName := FFSServerUser;
        SSHClient.Password := ''; //assume private key without key
file
        SSHClient.PrivateKeyFile := FPrivateKeyFile;
        SSHClient.ProtocolType := ptSSH;
        LastErrorText := SSHClient.Connect;
        if not SSHClient.Connected then
          raise Exception.CreateFmt('TimerCalled: error connecting:
%s',[LastErrorText]);

        // Run actual command
        WhenRun := now;
        // Connections directly to/from router: -t -u: tcp/udp; -W
wide
        NetstatOutput.Text := SSHClient.CommandResult('netstat -t -u
-W');
        // NAT connections via router; -x: extended hostname (i.e.
wide)
        NatOutput.Text := SSHCLient.CommandResult('netstat-nat -x');
        // Assume we can run exit to logoff
        // Note we do not wait for server to return; some broken
        // telnet implementations just hang here
        SSHClient.Command('exit');
        // Manual pause to give remote side time to respond
        Sleep(80);
        // Logout+disconnect:
        SSHClient.Disconnect;
      except
        on E: Exception do
        begin
          writeln('TimerCalled: Exception message: '+E.Message);
        end;
      end;

      // Output results.
      try
        DBConnection.HostName := FDBServer;
        DBConnection.DatabaseName := FDBDatabase;
        DBConnection.UserName := FDBUser;
        DBConnection.Password := FDBPassword;
        DBConnection.Transaction:=Transaction;
        DBConnection.Connected:=true;

        InsertQuery.DataBase:=DBConnection;
        InsertQuery.SQL.Text:=
          'insert into connections
(protocol,localhost,localport,remotehost,'+
          'remoteport,whenconnected) '+
          'values
(:protocol,:localhost,:localport,:remotehost,:remoteport,:'+
          'whenconnected); ';
        InsertQuery.Prepare;

        if not Transaction.Active then
          Transaction.StartTransaction;
        for i := 0 to NetstatOutput.Count - 1 do
        begin
          // filter out only netstat tcp/udp sockets
          // 0 & 272 are receive q, send q, can be ignored
          //tcp        0    272 router.intra.lan:38414               
             devsrver1.intra.lan:41792
          if (copy(NetstatOutput[i],1,length('tcp'))='tcp') or
          (copy(NetstatOutput[i],1,length('udp'))='udp') then
          begin
           
InsertQuery.Params.ParamByName('whenconnected').AsDateTime:=WhenRun;
            InsertQuery.Params.ParamByName('protocol').AsString:=Extra
ctWord(1,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=Extr
actWord(4,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=Extr
actWord(5,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=Ext
ractWord(6,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=Ext
ractWord(7,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.ExecSQL;
          end;
        end;
        for i := 0 to NatOutput.Count - 1 do
        begin
          // filter out header only use detail records:
          // tcp   ahost.intra.lan:54796 seadl-cont.mail.com:imaps   
 ESTABLISHED
          if (copy(NatOutput[i],1,length('tcp'))='tcp') or
          (copy(NatOutput[i],1,length('udp'))='udp') then
          begin
           
InsertQuery.Params.ParamByName('whenconnected').AsDateTime:=WhenRun;
            InsertQuery.Params.ParamByName('protocol').AsString:=Extra
ctWord(1,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=Extr
actWord(2,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=Extr
actWord(3,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=Ext
ractWord(4,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=Ext
ractWord(5,NatOutput[i],[#9,' ',':']);
            InsertQuery.ExecSQL;
          end;
        end;
        Transaction.Commit;
      except
        on D: EIBDatabaseError do
        begin
          writeln('TimerCalled: Database error code:
',D.GDSErrorCode,' message: '+D.Message);
        end;
        on E: Exception do
        begin
          writeln('TimerCalled: Exception message: '+E.Message);
        end;
      end;
    finally
      NatOutput.Free;
      NetstatOutput.Free;
      InsertQuery.Free;
      DBConnection.Free;
      Transaction.Free;
      SSHClient.Free;
    end;
  end;

// Write output to console if debugging
// Deliberately called the same as the Lazarus equivalent
procedure Debugln(const Message: string);
begin
  {$IFDEF DEBUG}
  writeln(formatdatetime('hh:mm:ss',Now,[])+': '+Message);
  {$ENDIF}
end;

var
  Worker: TWorkerClass;
  StartTime: TDateTime;
  Interval: TDateTime;
begin
  Interval:=EncodeTime(0,15,0,0); //quarter of an hour
  Worker := TWorkerClass.Create;
  try
    while (True) do
    begin
      try
        debugln('ready to call job');
        Worker.TimerCalled(nil); //run job
        debugln('job called');
        StartTime:=now;
        while (now-StartTime<Interval) do
        begin
          debugln('sleeping 20 seconds');
          sleep(20000); //yield 20 seconds to other processes. Better
way?
          //to do: handle sighup?
        end;
      except
        on E: Exception do
        begin
          writeln('Main loop error: exception message: '+E.Message);
          halt(129);
        end;
      end;
    end;
  finally
    Worker.Free;
  end;
end.

----------------------------------------------------------------------
BigChimp · 2014-07-17 15:52

Did the obvious (finally) and trimmed down the example still more so
Code: [Select]procedure TWorkerClass.TimerCalled(Sender: TObject);
only outputs a message via debugln.
First 2 jobs went ok, going to let it run to see what happens.

So - is there some memory corruption going on in TimerCalled that
influences the main loop? I would think normal exceptions would have
been caught in the try.. blocks?!?

----------------------------------------------------------------------
BigChimp · 2014-07-18 13:40

Argh noticed wrong subforum. Mods could you move this to FPC/Unix or
FPC/General? Thanks.

Have stripped out both:
1. The database part
2. The openssh connecting part
in TimerCalled
1: code ran ok
2 code crashed so that points at the database stuff. Am I really doing
something stupid? Is an error in TimerCalled corrupting memory or
something so the crash is only evident in the main loop?

Help

----------------------------------------------------------------------
BigChimp · 2014-07-18 13:48

Did decide to *cough* close the dbconnection when done:
Code: [Select]program netboss;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  {$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}
  {$ENDIF}
  Classes,
  SysUtils,
  processutils,
  {$ifdef unix}
  opensshwrapper,
  {$endif}
  {$ifdef mswindows}
  ClientSSH2,
  {$endif}
  sqldb,
  IBConnection,
  strutils;

{
Firebird database:
CREATE TABLE CONNECTIONS
(
  ID INTEGER NOT NULL,
  PROTOCOL VARCHAR(10),
  LOCALHOST VARCHAR(255),
  LOCALPORT VARCHAR(15) CHARACTER SET NONE,
  REMOTEHOST VARCHAR(255),
  REMOTEPORT VARCHAR(15) CHARACTER SET NONE,
  WHENCONNECTED TIMESTAMP,
  CONSTRAINT CONNECTIONS_PK_1 PRIMARY KEY (ID)
);

GRANT DELETE, INSERT, REFERENCES, SELECT, UPDATE
 ON CONNECTIONS TO  SYSDBA WITH GRANT OPTION;


SET TERM ^ ;
CREATE TRIGGER CONNECTIONS_ID_GEN FOR CONNECTIONS ACTIVE
BEFORE INSERT POSITION 0
AS BEGIN


IF (NEW.ID IS NULL OR NEW.ID = 0) THEN


  NEW.ID = GEN_ID(connections_ID_Gen, 1);


END^
SET TERM ; ^

}

type
  { TWorkerClass }

  TWorkerClass = class(TObject)
  private
    FDBServer: string;
    FDBUser: string;
    FDBPassword: string;
    FDBDatabase: string;
    FPrivateKeyFile: string;
    //Private key for SSH communication. Assumes key is same for all
devices...
    FFSServerIP: string;
    //Router IP address; should be user customisable
    FFSServerPort: integer; //Port to use for ssh access
    FFSServerUser: string; //Username for ssh/telnet access to local
router
  public
    // Runs actual job; if TFTPTimer were used, Sender would be
needed.
    procedure TimerCalled(Sender: TObject);
    constructor Create;
    destructor Destroy; override;
  end;

  { TWorkerClass }

  constructor TWorkerClass.Create;
  begin
    try
      //FFSServerHostType := htLinux; //our router is linux
      // Userl customization - this file should be protected
      // If you hit compile errors here, please copy
confidential_sample.inc to confidential.inc
      // and adjust contents to match your passwords etc
      {$include confidential.inc}

      // Try to find private key in application directory or ~/ssh/ or
home folder
      if FPrivateKeyFile='' then
        raise Exception.Create('Private key file not specified. It is
required.');
      if not(FileExists(FPrivateKeyFile)) then
        FPrivateKeyFile:=IncludeTrailingPathDelimiter(ExtractFilePath(
ParamStr(0)))+ExtractFileName(FPrivateKeyFile);
      if not(FileExists(FPrivateKeyFile)) then
        FPrivateKeyFile:=IncludeTrailingPathDelimiter(ExpandFileName('
~/.ssh'))+ExtractFileName(FPrivateKeyFile);
      if not(FileExists(FPrivateKeyFile)) then
        FPrivateKeyFile:=IncludeTrailingPathDelimiter(ExpandFileName('
~'))+ExtractFileName(FPrivateKeyFile);

      if (FPrivateKeyFile <> '') and (not fileexists(FPrivateKeyFile))
then
        raise Exception.CreateFmt('Private key file %s not found.
Aborting.',[FPrivateKeyFile]);

      //todo: check permissions for private key are correct: go-rwx
    except
      on E: Exception do
      begin
        writeln('TWorkerClass.Create: error: exception '+E.Message);
        halt(128);
      end;
    end;
  end;

  destructor TWorkerClass.Destroy;
  begin
    inherited Destroy;
  end;


  procedure TWorkerClass.TimerCalled(Sender: TObject);
  var
    {$ifdef mswindows}
    SSHClient: TTelnetSSHClient;
    {$else}
    SSHClient: TOpenSSH;
    {$endif}
    DBConnection: TIBConnection;
    InsertQuery: TSQLQuery;
    NatOutput: TStringList;
    NetstatOutput: TStringList; //output from netstat
    LastErrorText: string;
    Trans: TSQLTransaction;
    WhenRun: TDateTime;
    i: integer;
  begin
    NatOutput:=TStringList.Create;
    NetstatOutput:=TStringList.Create;
    DBConnection := TIBConnection.Create(nil);
    Trans:=TSQLTransaction.Create(nil);
    InsertQuery:=TSQLQuery.Create(nil);
    {$ifdef mswindows}
    SSHClient := TTelnetSSHClient.Create;
    {$else}
    SSHClient := TOpenSSH.Create;
    {$endif}
    try
      try
        SSHClient.HostName := FFSServerIP;
        SSHClient.Port := IntToStr(FFSServerPort);
        SSHClient.UserName := FFSServerUser;
        SSHClient.Password := ''; //assume private key without key
file
        SSHClient.PrivateKeyFile := FPrivateKeyFile;
        SSHClient.ProtocolType := ptSSH;
        LastErrorText := SSHClient.Connect;
        if not SSHClient.Connected then
          raise Exception.CreateFmt('TimerCalled: error connecting:
%s',[LastErrorText]);

        // Run actual command
        WhenRun := now;
        // Connections directly to/from router: -t -u: tcp/udp; -W
wide
        NetstatOutput.Text := SSHClient.CommandResult('netstat -t -u
-W');
        // NAT connections via router; -x: extended hostname (i.e.
wide)
        NatOutput.Text := SSHCLient.CommandResult('netstat-nat -x');
        // Assume we can run exit to logoff
        // Note we do not wait for server to return; some broken
        // telnet implementations just hang here
        SSHClient.Command('exit');
        // Manual pause to give remote side time to respond
        Sleep(80);
        // Logout+disconnect:
        SSHClient.Disconnect;
      except
        on E: Exception do
        begin
          writeln('TimerCalled: Error connecting via SSH. Exception
message: '+E.Message);
        end;
      end;

      // Output results.
      try
        DBConnection.HostName := FDBServer;
        DBConnection.DatabaseName := FDBDatabase;
        DBConnection.UserName := FDBUser;
        DBConnection.Password := FDBPassword;
        DBConnection.Transaction:=Trans;
        DBConnection.Connected:=true;

        InsertQuery.DataBase:=DBConnection;
        InsertQuery.SQL.Text:=
          'insert into connections
(protocol,localhost,localport,remotehost,'+
          'remoteport,whenconnected) '+
          'values
(:protocol,:localhost,:localport,:remotehost,:remoteport,:'+
          'whenconnected); ';

        if not Trans.Active then
          Trans.StartTransaction;
        for i := 0 to NetstatOutput.Count - 1 do
        begin
          // filter out only netstat tcp/udp sockets
          // 0 & 272 are receive q, send q, can be ignored
          //tcp        0    272 router.intra.lan:38414               
             devsrver1.intra.lan:41792
          if (copy(NetstatOutput[i],1,length('tcp'))='tcp') or
          (copy(NetstatOutput[i],1,length('udp'))='udp') then
          begin
           
InsertQuery.Params.ParamByName('whenconnected').AsDateTime:=WhenRun;
            InsertQuery.Params.ParamByName('protocol').AsString:=Extra
ctWord(1,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=Extr
actWord(4,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=Extr
actWord(5,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=Ext
ractWord(6,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=Ext
ractWord(7,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.ExecSQL;
          end;
        end;
        for i := 0 to NatOutput.Count - 1 do
        begin
          // filter out header only use detail recors:
          // tcp   ahost.intra.lan:54796 seadl-cont.mail.com:imaps   
 ESTABLISHED
          if (copy(NatOutput[i],1,length('tcp'))='tcp') or
          (copy(NatOutput[i],1,length('udp'))='udp') then
          begin
           
InsertQuery.Params.ParamByName('whenconnected').AsDateTime:=WhenRun;
            InsertQuery.Params.ParamByName('protocol').AsString:=Extra
ctWord(1,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=Extr
actWord(2,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=Extr
actWord(3,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=Ext
ractWord(4,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=Ext
ractWord(5,NatOutput[i],[#9,' ',':']);
            InsertQuery.ExecSQL;
          end;
        end;
        Trans.Commit;
        DBConnection.Close;
      except
        on D: EIBDatabaseError do
        begin
          writeln('TimerCalled: Database problems. Database error
code: ',D.GDSErrorCode,' message: '+D.Message);
        end;
        on E: Exception do
        begin
          writeln('TimerCalled: Database problems. Exception message:
'+E.Message);
        end;
      end;
    finally
      NatOutput.Free;
      NetstatOutput.Free;
      InsertQuery.Free;
      DBConnection.Free;
      Trans.Free;
      SSHClient.Free;
    end;
  end;

// Write output to console if debugging
// Deliberately called the same as the Lazarus equivalent
procedure Debugln(const Message: string);
begin
  {$IFDEF DEBUG}
  writeln(formatdatetime('hh:mm:ss',Now,[])+': '+Message);
  {$ENDIF}
end;

var
  Worker: TWorkerClass;
  StartTime: TDateTime;
  Interval: TDateTime;
begin
  Interval:=EncodeTime(0,15,0,0); //quarter of an hour
  Worker := TWorkerClass.Create;
  try
    while (True) do
    begin
      try
        debugln('ready to call job');
        Worker.TimerCalled(nil); //run job
        debugln('job called');
        StartTime:=now;
        while (now-StartTime<Interval) do
        begin
          debugln('sleeping 20 seconds');
          sleep(20000); //yield 20 seconds to other processes. Better
way?
          //handle sighup?
        end;
      except
        on E: Exception do
        begin
          writeln('Main loop error: exception message: '+E.Message);
          halt(129);
        end;
      end;
    end;
  finally
    Worker.Free;
  end;
end.

Edit... no difference, still an AV on my prod system...

----------------------------------------------------------------------
User137 · 2014-07-18 17:14

Have you tried to set breakpoints and run line-by-line to see where it
stops?

----------------------------------------------------------------------
BigChimp · 2014-07-19 08:50

No not yet, as it's on a server. I will install gdb and see where it
crashes, and possibly indeed try and step through... (ah, finally the
joys of text mode gdb in all its glory  )

----------------------------------------------------------------------
BigChimp · 2014-07-19 10:39

Interesting.
Ran a debug build (which defines -dDEBUG) on the server under gdb...
no crash.
As DEBUG is DEFINEd in the program, it spits out writelns.... which
seems to influence behaviour here...?!

Release mode crashed almost immediately (first or second sleep call)
with access violation.
Adding writeln(); before the sleep call caused it not to crash.
Write() instead of writeln() still crashed.

Waiting for a longer test with release mode+writeln

All running fpc trunk.

----------------------------------------------------------------------
BigChimp · 2014-07-19 12:22

And of course, the writeln stuff didn't always work either.

Reset the code, compiled with FPC 2.6.4, release mode, no writeln.
strace output (slightly obfuscated w/ regards to server names etc) -
see attachment

----------------------------------------------------------------------
engkin · 2014-07-19 22:10

This is just speculation. Based on your strace file:
1-A thread was created:
Quoteclone(child_stack=0x7f538b8e8ff0, flags=CLONE_VM|CLONE_FS|CLONE_F
ILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PAREN
T_SETTID|CLONE_CHILD_CLEARTID, parent_tidptr=0x7f538b8e99d0,
tls=0x7f538b8e9700, child_tidptr=0x7f538b8e99d0) = 13711
Its id (13711) was stored in 0x7f538b8e99d0

2-A preparation for a mutex waiting for the thread failed:
Quotefutex(0x7f538b8e99d0, FUTEX_WAIT, 13711, NULL) = -1 EAGAIN
(Resource temporarily unavailable)
most likely because the thread was already done and had changed its
cid from 13711 to 0 as instructed with CLONE_CHILD_CLEARTID flag
above. Probably some code touched the thread after this point and
cause an AV.

http://man7.org/linux/man-pages/man2/clone.2.html
http://man7.org/linux/man-pages/man2/futex.2.html

----------------------------------------------------------------------
marcov · 2014-07-19 22:20

Seems that sem_wait and sem_trywait can return EAGAIN. You might want
to look them up in rtl/unix/cthreads.inc and wrap them in a repeat
until not (result=1 and errno=eagain) or something, and retry.

----------------------------------------------------------------------
BigChimp · 2014-07-22 10:54

Sorry, busy with other things, only got back here.

Thanks a lot, engkin & marcov
Quote from: engkin on July 20, 2014, 12:10:43 amThis is just
speculation. Based on your strace file:
1-A thread was created:
... hmmm, though the program is not multithreaded.. perhaps the
firebird client created a thread? I had disabled the cthreads unit but
perhaps it's a good idea to enable it..?!?

Quote from: marcov on July 20, 2014, 12:20:41 amSeems that sem_wait
and sem_trywait can return EAGAIN. You might want to look them up in
rtl/unix/cthreads.inc and wrap them in a repeat until not (result=1
and errno=eagain) or something, and retry.
Ok, going to have a look, thanks.

----------------------------------------------------------------------
BigChimp · 2014-07-23 09:57

Hmmm, if I
1. apply this patch:
Code: [Select]Index: trunk/fpc/rtl/unix/cthreads.pp
===================================================================
--- trunk/fpc/rtl/unix/cthreads.pp      (revision 28248)
+++ trunk/fpc/rtl/unix/cthreads.pp      (working copy)
@@ -527,7 +527,7 @@
   repeat
     res:=sem_wait(PSemaphore(FSem));
     err:=fpgetCerrno;
-  until (res<>-1) or (err<>ESysEINTR);
+  until (res<>-1) or ((err<>ESysEINTR) and (err<>ESysEAgain));
 {$else}
   repeat
     res:=fpread(PFilDes(FSem)^[0], b, 1);
(covers sem_wait; sem_trywait already checks for ESysEagain)

2. Compile with cthreads in the uses clause of my program

3. Run, I get this strace:
...
Code: [Select]clone(child_stack=0x7f877f4c2ff0, flags=CLONE_VM|CLONE_F
S|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CL
ONE_PARENT_SETTID|CLONE_CHILD_CLEARTID, parent_tidptr=0x7f877f4c39d0,
tls=0x7f877f4c3700, child_tidptr=0x7f877f4c39d0) = 24640
futex(0x7fff2562ded0, FUTEX_WAIT_BITSET_PRIVATE|FUTEX_CLOCK_REALTIME,
0, {1406108302, 583101000}, ffffffff) = 0
futex(0x7f8783936058, FUTEX_WAKE_PRIVATE, 1) = 1
munmap(0x7f8783928000, 65536)           = 0
munmap(0x7f8783918000, 65536)           = 0
munmap(0x7f8782906000, 7287744)         = 0
munmap(0x7f878258b000, 3648368)         = 0
munmap(0x7f87804fc000, 25608208)        = 0
munmap(0x7f8783943000, 32768An unhandled exception occurred at
$00007F8782AA7346:
)           = 0
EAccessViolation: Access violation
  $00007F8782AA7346
gettimeofday(
{1406108297, 583702}, NULL) = 0
gettimeofday({1406108297, 583741}, NULL) = 0
nanosleep({20, 0},  <unfinished ... exit status 217>

BTW:
Quote from: engkin on July 20, 2014, 12:10:43 amThis is just
speculation. Based on your strace file:
1-A thread was created:
Quoteclone(child_stack=0x7f538b8e8ff0, flags=CLONE_VM|CLONE_FS|CLONE_F
ILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PAREN
T_SETTID|CLONE_CHILD_CLEARTID, parent_tidptr=0x7f538b8e99d0,
tls=0x7f538b8e9700, child_tidptr=0x7f538b8e99d0) = 13711
Its id (13711) was stored in 0x7f538b8e99d0

2-A preparation for a mutex waiting for the thread failed:
Quotefutex(0x7f538b8e99d0, FUTEX_WAIT, 13711, NULL) = -1 EAGAIN
(Resource temporarily unavailable)
most likely because the thread was already done and had changed its
cid from 13711 to 0 as instructed with CLONE_CHILD_CLEARTID flag
above. Probably some code touched the thread after this point and
cause an AV.
... looks like a thread created by the Firebird .so as I see it
reading the firebird config - if I'm guessing correctly based on the
second line
Code: [Select]clone(child_stack=0x7f538b8e8ff0, flags=CLONE_VM|CLONE_F
S|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CL
ONE_PARENT_SETTID|CLONE_CHILD_CLEARTID, parent_tidptr=0x7f538b8e99d0,
tls=0x7f538b8e9700, child_tidptr=0x7f538b8e99d0) = 13711
open("/etc/firebird/2.5/firebird.conf", O_RDONLY) = 3

----------------------------------------------------------------------
BigChimp · 2014-08-07 13:12

Just tested (one of the variations of - sorry can't be bothered to
keep exact track now) the program with the patch in
http://bugs.freepascal.org/view.php?id=26561
and it runs fine on my server.

Looks like the patch fixes the problem... If not, I'll revisit this

Thanks for all the help, everyone!