linux

.gitignore

@@ -12,7 +12,7 @@
 *.o
 *.or
 *.a
-
+*.log
 # Lazarus autogenerated files (duplicated info)
 *.rst
 *.rsj

cgi_daemon.pas

@@ -5,7 +5,7 @@ unit cgi_daemon;
 interface
 
 uses
-  Classes, SysUtils, DaemonApp, ConnectionsDmUnit;
+  Classes, SysUtils, DaemonApp, ConnectionsDmUnit,eventlog;
 
 type
   TLMSReportCGI=class;
@@ -14,6 +14,7 @@ type
   TDaemonThread=class(TThread)
     fOwner: TLMSReportCGI;
     fData: TConnectionsDM;
+    fLogger: TEventLog;
     procedure Execute;override;
     function sleepMin(n: integer): boolean;
     constructor Create(AOwner: TLMSReportCGI);
@@ -36,7 +37,8 @@ var
   LMSReportCGI: TLMSReportCGI;
 
 implementation
-
+uses
+  LazLogger;
 procedure RegisterDaemon;
 begin
   RegisterDaemonClass(TLMSReportCGI)
@@ -48,6 +50,14 @@ end;
 
 procedure TLMSReportCGI.DataModuleCreate(Sender: TObject);
 begin
+  //{$IFDEF WINDOWS}
+  self.Logger.Active:=false;
+  self.Logger.AppendContent:=true;
+  self.Logger.LogType := ltFile;
+  self.Logger.FileName := format('%s/server.log',[extractfilepath(paramstr(0))]);
+  self.Logger.Active:=true;
+  //{$ENDIF}
+  self.logger.Info('TLMSReportCGI.DataModuleCreate');
   workThread := TDaemonThread.create(self);
 end;
 
@@ -58,13 +68,15 @@ end;
 
 procedure TLMSReportCGI.DataModuleStart(Sender: TCustomDaemon; var OK: Boolean);
 begin
-
+  logger.Info('start daemon thread');
   workThread.Start;
+  logger.Info('daemon thread started');
   OK := true;
 end;
 
 procedure TLMSReportCGI.DataModuleStop(Sender: TCustomDaemon; var OK: Boolean);
 begin
+  debugln('stop daemon thread');
   workThread.Terminate;
 end;
 
@@ -72,13 +84,19 @@ end;
 
 procedure TDaemonThread.Execute;
 begin
-  fData := TConnectionsDM.Create(nil);
+  flogger.Info('TDaemonThread.Execute');
+  fData := TConnectionsDM.CreateWithLog(fLogger);
   try
+    fData.logger := fLogger;
+    fData.log(self,'logging');
+    flogger.Info('TDaemonThread.Execute.1');
     fData.Start;
+    flogger.Info('TDaemonThread.Execute.2');
     while not terminated do
       begin
       if sleepMin(2) then
         fData.Idle(self);
+      flogger.Info('TDaemonThread.Idle');
       end;
     fData.Stop;
   finally
@@ -102,6 +120,7 @@ constructor TDaemonThread.Create(AOwner: TLMSReportCGI);
 begin
   inherited Create(true);
   fOwner:=AOwner;
+  fLogger:=AOwner.Logger;
 end;
 
 

cgidm.pas

@@ -48,6 +48,7 @@ type
     procedure log(Sender: TObject; msg: string);
     procedure LogError(Sender: TObject; e: Exception; msg: string);
     procedure ExecuteSQL(ASQL: string);
+    constructor CreateWithLogger(ALogger: TLogger);
   end;
 
 var
@@ -62,9 +63,9 @@ uses
 
 procedure TNIDBDM.DataModuleCreate(Sender: TObject);
 begin
-  log(self,'connecting');
+  log(sender,'TnnzConnection.Create');
   fcon := TnnzConnection.Create(self);
-
+  log(sender,'TnnzConnection.Create.ok');
 
 end;
 
@@ -359,5 +360,12 @@ begin
   connection.ExecuteSQL(ASQL);
 end;
 
+constructor TNIDBDM.CreateWithLogger(ALogger: TLogger);
+begin
+  fLogger := ALogger;
+  log(nil,'TNIDBDM.Create');
+  inherited Create(nil);
+end;
+
 end.
 

connectionsdmunit.pas

@@ -5,8 +5,8 @@ unit ConnectionsDmUnit;
 interface
 
 uses
-  Classes, Contnrs, SysUtils, types, process, cgiDM, reportDMUnit, LNet,
+  Classes, Contnrs, SysUtils, types, process, cgiDM, reportDMUnit, LNet,eventlog,
-  lnetbase,tcpserver, tcpthreadhelper, DCPsha1, extTypes,syncobjs, baseconnection;
+  lnetbase,tcpserver, tcpthreadhelper, DCPsha1, extTypes,syncobjs, baseconnection,LazLoggerBase,LazLogger;
 
 type
 
@@ -32,7 +32,7 @@ type
     fDataPort: integer;
     fDataBase: string;
     fServicePort: integer;
-
+    fLogger: TEventLog;
     fTimeOut: integer;
     LogLock: TCriticalSection;
     fRunning: boolean;
@@ -51,6 +51,7 @@ type
     property DataHost: string read fDataHost;
     property DataPort: integer read fDataPort;
     property DataBase: string read fDataBase;
+    property Logger: TEventLog read fLogger write fLogger;
     procedure Log(Sender: TObject; msg: string);
     procedure Start;
     procedure Stop;
@@ -59,7 +60,7 @@ type
     function ProcessRequest(Sender: TMainThread;
       const CommandID:DWORD; const Param:QWord; const ACommand: string; const Fields: TStrings; const iParams: TParamArray;  const Data: TStream;
       out Code: DWORD; out RetValue: QWord; out Answer: string; out rValues: TStrings; out iValues: TParamArray; out ByteData: TStream ): boolean;
-
+    constructor CreateWithLog(ALogger: TEventLog);
   end;
 
 var
@@ -77,13 +78,21 @@ uses
 
 procedure TConnectionsDM.DataModuleCreate(Sender: TObject);
 begin
-  MainCon := TNIDBDM.Create(nil);
+  log(sender,'datamodulecreate-0');
-  MainCon.logger:=@log;
+  fRunning := false;
+  log(sender,'datamodulecreate.1');
   LogLock := TCriticalSection.Create;
   conList := TList.Create;
+  log(sender,'datamodulecreate.2');
+  MainCon := TNIDBDM.CreateWithLogger(@log);
+  log(sender,'datamodulecreate.3');
+  MainCon.logger:=@log;
+
   LoadConfig;
-  fRunning := false;
+  log(sender,'datamodulecreate.4');
+
   input := TServerMainThread.Create(@log,fServicePort,@ProcessRequest);
+  log(sender,'datamodulecreate.ok');
 end;
 
 procedure TConnectionsDM.DataModuleDestroy(Sender: TObject);
@@ -236,7 +245,7 @@ begin
   if ACommand='login' then
     begin
       UserName :=Fields.Values['user'];
-      if ProcessLogin(UserName,EncryptText(Fields.Values['password']),UserID) then
+      if ProcessLogin(UserName,EncryptText(Fields.Values['password'],Hash),UserID) then
         begin
           con := NewConnection;
           con.User:=UserName;
@@ -336,6 +345,12 @@ begin
 
 end;
 
+constructor TConnectionsDM.CreateWithLog(ALogger: TEventLog);
+begin
+  fLogger:=Alogger;
+  inherited Create(nil);
+end;
+
 function TConnectionsDM.ProcessLogin(UserName, UserPassword: string; out  UserID: integer): boolean;
 var
   ASQL: string;
@@ -482,28 +497,16 @@ procedure TConnectionsDM.Log(Sender: TObject; msg: string);
 var
   f: TextFile;
 begin
+  if not assigned(fLogger) then exit;
+  try
 
-  try
+//  assignefile(fLogFolder
-    if fLogFolder='' then exit;
-    LogLock.Enter;
-    try
-  AssignFile(f, fLogFolder);
-  if fileexists(fLogFolder) then
-    append(f)
-  else
-    rewrite(f);
   if Sender is TComponent then
-    writeln(f,DateTimeToStr(NOW()),#09,Sender.ClassName,'-',(Sender as TComponent).Name, #09, Msg)
+    flogger.Debug(DateTimeToStr(NOW())+#09+Sender.ClassName+'-'+(Sender as TComponent).Name+#09+Msg)
   else if Assigned(Sender) then
-    writeln(f,DateTimeToStr(NOW()),#09,Sender.ClassName, #09, Msg)
+    flogger.Debug(DateTimeToStr(NOW())+#09+Sender.ClassName+ #09+ Msg)
   else
-    writeln(f,DateTimeToStr(NOW()),#09, #09, Msg);
+    flogger.Debug(DateTimeToStr(NOW())+#09+ #09+ Msg);
-  closeFile(f);
-
-    finally
-      logLock.Leave;
-    end;
-
   except on e: Exception do
     raise;
   end;

lms_cgi_server.ini

@@ -4,4 +4,4 @@ port=7079
 database=lms
 [PARAMS]
 port=6543
-log=D:\PROJECTS\LAZARUS\LMS\out\server.log
+log=/var/log/nintegra/cgireport.log

lmsreport.lpr

@@ -21,18 +21,7 @@ begin
   RequireDerivedFormResource:=True;
   Application.Scaled:=True;
   Application.Initialize;
-  if paramstr(1)='console' then
-  begin
   Application.CreateForm(TCGIServerGUI, CGIServerGUI);
   Application.Run;
-  end
-  else
-  begin
-  Application.CreateForm(TConnectionsDM,ConnectionsDM);
-  ConnectionsDM.start;
-  while ConnectionsDM.running do
-    sleep(1000);
-
-  end;
 end.
 

maintcpserver.lfm

@@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI
   ClientWidth = 870
   OnCreate = FormCreate
   OnDestroy = FormDestroy
-  LCLVersion = '2.2.4.0'
+  LCLVersion = '2.2.0.4'
   object Panel1: TPanel
     Left = 0
     Height = 50
@@ -45,14 +45,14 @@ object CGIServerGUI: TCGIServerGUI
     Width = 368
     Align = alLeft
     Caption = 'Запрос'
-    ClientHeight = 239
+    ClientHeight = 240
-    ClientWidth = 364
+    ClientWidth = 366
     TabOrder = 1
     object Keys: TMemo
       Left = 0
-      Height = 216
+      Height = 210
-      Top = 23
+      Top = 30
-      Width = 364
+      Width = 366
       Align = alClient
       Lines.Strings = (
         'user=nnz'
@@ -62,11 +62,11 @@ object CGIServerGUI: TCGIServerGUI
     end
     object edtRequest: TComboBox
       Left = 0
-      Height = 23
+      Height = 30
       Top = 0
-      Width = 364
+      Width = 366
       Align = alTop
-      ItemHeight = 15
+      ItemHeight = 0
       ItemIndex = 3
       Items.Strings = (
         'version'
@@ -91,40 +91,41 @@ object CGIServerGUI: TCGIServerGUI
     Width = 497
     Align = alClient
     Caption = 'Ответ'
-    ClientHeight = 239
+    ClientHeight = 240
-    ClientWidth = 493
+    ClientWidth = 495
     TabOrder = 2
     object edtAnswer: TEdit
       Left = 0
-      Height = 23
+      Height = 30
       Top = 25
-      Width = 493
+      Width = 495
       Align = alTop
       OnDblClick = edtAnswerDblClick
       TabOrder = 0
     end
     object retValues: TMemo
       Left = 0
-      Height = 88
+      Height = 75
-      Top = 71
+      Top = 85
-      Width = 493
+      Width = 495
       Align = alClient
       TabOrder = 1
     end
     object intValues: TListBox
       Left = 0
       Height = 80
-      Top = 159
+      Top = 160
-      Width = 493
+      Width = 495
       Align = alBottom
       ItemHeight = 0
       TabOrder = 2
+      TopIndex = -1
     end
     object edtQValue: TEdit
       Left = 0
-      Height = 23
+      Height = 30
-      Top = 48
+      Top = 55
-      Width = 493
+      Width = 495
       Align = alTop
       TabOrder = 3
     end
@@ -132,7 +133,7 @@ object CGIServerGUI: TCGIServerGUI
       Left = 0
       Height = 25
       Top = 0
-      Width = 493
+      Width = 495
       Align = alTop
       TabOrder = 4
     end

maintcpserver.pas

@@ -69,12 +69,13 @@ begin
   ConnectionsDM := Server;
   cmdDone := true;
   started := false;
-  SendButton.Enabled := false;
+  SendButton.Enabled := Paramstr(1)='client';
+  StartButton.Enabled := not SendButton.Enabled;
 end;
 
 procedure TCGIServerGUI.SendButtonClick(Sender: TObject);
 begin
-  if not started then exit;
+  if not started and StartButton.enabled then exit;
   client := TClientMainThread.Create(edtRequest.Text,Keys.Lines,@Server.log,'localhost',6543,@onAnswer);
   LogQuery(0,edtRequest.Text,Keys.Lines,0,0,[]);
   cmdDone := false;

tcpclient.pas

@@ -60,6 +60,7 @@ end;
 
 procedure TClientMainThread.execute;
 begin
+  doStart;
   log(self,'start main thread');
   Connect.Connect(Host,Port);
   while not terminated do

tcpserver.pas

@@ -60,6 +60,7 @@ procedure TServerMainThread.execute;
 var
   n: integer;
 begin
+  doStart;
   log(self,'start main thread');
   Connect.Listen(Port);
   n := 0;

tcpthreadhelper.pas

@@ -85,10 +85,12 @@ type
       fclients: TList;
       flogger: TLogger;
       fThreadClass: TConnectionThreadClass;
+      fStarted:boolean;
       function getThread(index: TLSocket): TConnectionThread;
       procedure TerminateClients;
     protected
       procedure Log(Sender:TObject; msg: string);
+      procedure doStart; virtual;
     public
       property Port: integer read fPort;
       property Connect: TLTCP read fCon;
@@ -100,7 +102,7 @@ type
     procedure Accept(aSocket: TLSocket);
     procedure doDisconnect(aSocket: TLSocket);
     procedure doConnect(aSocket: TLSocket);
-    procedure doTerminate;override;
+    procedure TerminatedSet;override;
     procedure NetError(const msg: string; aSocket: TLSocket);
     constructor Create(AThreadClass: TConnectionThreadClass; ALogger: TLogger; APort: integer);
     destructor Destroy; override;
@@ -148,8 +150,7 @@ begin
       log(self,GuidToString(clt.ID));
       clt.Terminate;
       clt.WaitFor;
-      clt.Free;
+      clt.free;
-
       except on e: Exception do
         begin
           log(self, '!!ERROR Destroy ' + e.Message);
@@ -166,6 +167,11 @@ begin
     fLogger(Sender,Msg);
 end;
 
+procedure TMainThread.doStart;
+begin
+  fStarted := true;
+end;
+
 procedure TMainThread.RemoveClient(clt: TConnectionThread);
 begin
   fclients.Remove(clt);
@@ -221,8 +227,6 @@ begin
   if clt.terminated then exit;
   log(self,format('disconnected %s on %d ',[GUIDToString(clt.ID), aSocket.Handle]));
   clt.Terminate;
-  clt.WaitFor;
-  clt.free;
   fclients.remove(clt);
 
   except on e: Exception do
@@ -245,9 +249,10 @@ begin
   clt.Start;
 end;
 
-procedure TMainThread.doTerminate;
+procedure TMainThread.TerminatedSet;
 begin
-  inherited doTerminate();
+  inherited TerminatedSet();
+  if fStarted then
     TerminateClients;
 end;
 
@@ -266,6 +271,7 @@ constructor TMainThread.Create(AThreadClass: TConnectionThreadClass;
   ALogger: TLogger; APort: integer);
 begin
    inherited Create(true);
+  fStarted := false;
   fThreadClass:=AThreadClass;
   fCon := TLTcp.Create(nil);
   fclients := TList.Create;
@@ -970,6 +976,7 @@ var
   i,d1,d2 : integer;
 begin
   inherited Create(true);
+  //FreeOnTerminate:=true;
   fCache := TRoundBuffer.Create(10000);
   fSocket := ASocket;
   fOwner := AOwner;
@@ -980,10 +987,8 @@ end;
 
 destructor TConnectionThread.Destroy;
 begin
-  log('Destroy');
   fCache.Free;
   fOwner.removeClient(self);
-  log('Destroy2');
   inherited Destroy;
 end;
 
@@ -1018,14 +1023,14 @@ begin
       end;
     end;
   Cache.Close;
-  Socket.Disconnect();
+  //Socket.Disconnect();
-  log('terminated');
 end;
 
 procedure TConnectionThread.TerminatedSet;
 begin
   log('terminate required');
   Cache.Close;
+  fOwner.removeClient(self);
 end;
 
 { TClientThread }

xpaccessunit.pas

@@ -1,41 +1,41 @@
 unit xpAccessUnit;
 {$H+}
 interface
-
+uses
-  function EncryptText(const AText: String) : String;
+  DCPcrypt2;
-  function MySQLPassword(const AText: Ansistring) : Ansistring;
+  function EncryptText(const AText: String; aHash: TDCP_hash) : String;
+  function MySQLPassword(const AText: Ansistring; aHash: TDCP_hash) : Ansistring;
 implementation
 
 uses
   SysUtils,
-  Variants, DCPsha1, DCPdes,
+  Variants;
-  ConnectionsDmUnit;
 
 
 function DecryptText(const AText: string) : string;
 begin
   Result := AText;
 end;
-function EncryptText(const AText: String) : String;
+function EncryptText(const AText: String; aHash: TDCP_hash): String;
 begin
-  Result := String(MySQLPassword(AnsiString(StringReplace(AText, '\', '\\', [rfReplaceAll, rfIgnoreCase]))));
+  Result := String(MySQLPassword(AnsiString(StringReplace(AText, '\', '\\', [rfReplaceAll, rfIgnoreCase])),aHash));
 end;
 
 
-function MySQLPassword(const AText: Ansistring) : Ansistring;
+function MySQLPassword(const AText: Ansistring; aHash: TDCP_hash): Ansistring;
 var
   Digest: packed array[0..19] of byte;
   i: integer;
 begin
   Result := '*';
-  ConnectionsDM.Hash.Init;
+  aHash.Init;
-  ConnectionsDM.Hash.UpdateStr(AText);
+  aHash.UpdateStr(AText);
-  ConnectionsDM.Hash.Final(Digest);
+  aHash.Final(Digest);
-  ConnectionsDM.Hash.Burn;
+  aHash.Burn;
-  ConnectionsDM.Hash.Init;
+  aHash.Init;
-  ConnectionsDM.Hash.Update(Digest,20);
+  aHash.Update(Digest,20);
-  ConnectionsDM.Hash.Final(Digest);
+  aHash.Final(Digest);
-  ConnectionsDM.Hash.Burn;
+  aHash.Burn;
   for i:= 0 to 19 do
     Result := Result + AnsiString(IntToHex(Digest[i], 2));
 end;