Recent

Author Topic: [SOLVED] Access violations in simple program  (Read 11855 times)

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
[SOLVED] Access violations in simple program
« on: July 17, 2014, 04:40:22 pm »
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:=ExtractWord(1,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=ExtractWord(4,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=ExtractWord(5,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=ExtractWord(6,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=ExtractWord(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:=ExtractWord(1,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=ExtractWord(2,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=ExtractWord(3,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=ExtractWord(4,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=ExtractWord(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.
« Last Edit: August 07, 2014, 03:11:18 pm by BigChimp »
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #1 on: July 17, 2014, 05:52:12 pm »
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?!?
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #2 on: July 18, 2014, 03:40:28 pm »
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 ;)
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #3 on: July 18, 2014, 03:48:35 pm »
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:=ExtractWord(1,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=ExtractWord(4,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=ExtractWord(5,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=ExtractWord(6,NetstatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=ExtractWord(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:=ExtractWord(1,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localhost').AsString:=ExtractWord(2,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('localport').AsString:=ExtractWord(3,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remotehost').AsString:=ExtractWord(4,NatOutput[i],[#9,' ',':']);
            InsertQuery.Params.ParamByName('remoteport').AsString:=ExtractWord(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...
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

User137

  • Hero Member
  • *****
  • Posts: 1791
    • Nxpascal home
Re: Access violations in simple program
« Reply #4 on: July 18, 2014, 07:14:25 pm »
Have you tried to set breakpoints and run line-by-line to see where it stops?

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #5 on: July 19, 2014, 10:50:09 am »
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 ;) )
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #6 on: July 19, 2014, 12:39:56 pm »
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.
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #7 on: July 19, 2014, 02:22:56 pm »
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
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: Access violations in simple program
« Reply #8 on: July 20, 2014, 12:10:43 am »
This is just speculation. Based on your strace file:
1-A thread was created:
Quote
clone(child_stack=0x7f538b8e8ff0, flags=CLONE_VM|CLONE_FS|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PARENT_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:
Quote
futex(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

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: Access violations in simple program
« Reply #9 on: July 20, 2014, 12:20:41 am »
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

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #10 on: July 22, 2014, 12:54:18 pm »
Sorry, busy with other things, only got back here.

Thanks a lot, engkin & marcov
This 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..?!?

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.
Ok, going to have a look, thanks.
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: Access violations in simple program
« Reply #11 on: July 23, 2014, 11:57:06 am »
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_FS|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_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:
This is just speculation. Based on your strace file:
1-A thread was created:
Quote
clone(child_stack=0x7f538b8e8ff0, flags=CLONE_VM|CLONE_FS|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PARENT_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:
Quote
futex(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_FS|CLONE_FILES|CLONE_SIGHAND|CLONE_THREAD|CLONE_SYSVSEM|CLONE_SETTLS|CLONE_PARENT_SETTID|CLONE_CHILD_CLEARTID, parent_tidptr=0x7f538b8e99d0, tls=0x7f538b8e9700, child_tidptr=0x7f538b8e99d0) = 13711
open("/etc/firebird/2.5/firebird.conf", O_RDONLY) = 3
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: [SOLVED] Access violations in simple program
« Reply #12 on: August 07, 2014, 03:12:21 pm »
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!
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

 

TinyPortal © 2005-2018