diff --git a/.gitignore b/.gitignore index a8e6c49..7a227e5 100644 --- a/.gitignore +++ b/.gitignore @@ -12,7 +12,7 @@ *.o *.or *.a - +*.log # Lazarus autogenerated files (duplicated info) *.rst *.rsj diff --git a/U:/Apache/Apache24/cgi-bin/lms_cgi b/U:/Apache/Apache24/cgi-bin/lms_cgi index 89de75b..991d33f 100755 Binary files a/U:/Apache/Apache24/cgi-bin/lms_cgi and b/U:/Apache/Apache24/cgi-bin/lms_cgi differ diff --git a/cgi_daemon.pas b/cgi_daemon.pas index 8c6c150..01d7f8b 100644 --- a/cgi_daemon.pas +++ b/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; diff --git a/cgidm.pas b/cgidm.pas index 2869fec..c7510e8 100644 --- a/cgidm.pas +++ b/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. diff --git a/connectionsdmunit.pas b/connectionsdmunit.pas index ee631c0..5fbb1ca 100644 --- a/connectionsdmunit.pas +++ b/connectionsdmunit.pas @@ -5,8 +5,8 @@ unit ConnectionsDmUnit; interface uses - Classes, Contnrs, SysUtils, types, process, cgiDM, reportDMUnit, LNet, - lnetbase,tcpserver, tcpthreadhelper, DCPsha1, extTypes,syncobjs, baseconnection; + Classes, Contnrs, SysUtils, types, process, cgiDM, reportDMUnit, LNet,eventlog, + 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); - MainCon.logger:=@log; + log(sender,'datamodulecreate-0'); + 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 - if fLogFolder='' then exit; - LogLock.Enter; - try - AssignFile(f, fLogFolder); - if fileexists(fLogFolder) then - append(f) - else - rewrite(f); + +// assignefile(fLogFolder 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); - closeFile(f); - - finally - logLock.Leave; - end; - + flogger.Debug(DateTimeToStr(NOW())+#09+ #09+ Msg); except on e: Exception do raise; end; diff --git a/lms_cgi_server b/lms_cgi_server index 4916b63..c2289af 100755 Binary files a/lms_cgi_server and b/lms_cgi_server differ diff --git a/lms_cgi_server.ini b/lms_cgi_server.ini index 152728e..68a6798 100644 --- a/lms_cgi_server.ini +++ b/lms_cgi_server.ini @@ -4,4 +4,4 @@ port=7079 database=lms [PARAMS] port=6543 -log=D:\PROJECTS\LAZARUS\LMS\out\server.log \ No newline at end of file +log=/var/log/nintegra/cgireport.log \ No newline at end of file diff --git a/lmsreport b/lmsreport new file mode 100755 index 0000000..b4d78af Binary files /dev/null and b/lmsreport differ diff --git a/lmsreport.lpr b/lmsreport.lpr index 50d0e95..78a3b0c 100644 --- a/lmsreport.lpr +++ b/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. diff --git a/maintcpserver.lfm b/maintcpserver.lfm index 8e4c06d..4e696b4 100644 --- a/maintcpserver.lfm +++ b/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 - ClientWidth = 364 + ClientHeight = 240 + ClientWidth = 366 TabOrder = 1 object Keys: TMemo Left = 0 - Height = 216 - Top = 23 - Width = 364 + Height = 210 + Top = 30 + 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 - ClientWidth = 493 + ClientHeight = 240 + 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 - Top = 71 - Width = 493 + Height = 75 + Top = 85 + Width = 495 Align = alClient TabOrder = 1 end object intValues: TListBox Left = 0 Height = 80 - Top = 159 - Width = 493 + Top = 160 + Width = 495 Align = alBottom ItemHeight = 0 TabOrder = 2 + TopIndex = -1 end object edtQValue: TEdit Left = 0 - Height = 23 - Top = 48 - Width = 493 + Height = 30 + Top = 55 + 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 diff --git a/maintcpserver.pas b/maintcpserver.pas index 72ca0f7..f3f26db 100644 --- a/maintcpserver.pas +++ b/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; diff --git a/tcpclient.pas b/tcpclient.pas index 6a43057..c82222a 100644 --- a/tcpclient.pas +++ b/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 diff --git a/tcpserver.pas b/tcpserver.pas index e712835..ac3da16 100644 --- a/tcpserver.pas +++ b/tcpserver.pas @@ -60,6 +60,7 @@ procedure TServerMainThread.execute; var n: integer; begin + doStart; log(self,'start main thread'); Connect.Listen(Port); n := 0; diff --git a/tcpthreadhelper.pas b/tcpthreadhelper.pas index 626aba7..7ef99ed 100644 --- a/tcpthreadhelper.pas +++ b/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,10 +249,11 @@ begin clt.Start; end; -procedure TMainThread.doTerminate; +procedure TMainThread.TerminatedSet; begin - inherited doTerminate(); - TerminateClients; + 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(); - log('terminated'); + //Socket.Disconnect(); end; procedure TConnectionThread.TerminatedSet; begin log('terminate required'); Cache.Close; + fOwner.removeClient(self); end; { TClientThread } diff --git a/xpaccessunit.pas b/xpaccessunit.pas index afa8722..5d79509 100644 --- a/xpaccessunit.pas +++ b/xpaccessunit.pas @@ -1,41 +1,41 @@ unit xpAccessUnit; {$H+} interface - - function EncryptText(const AText: String) : String; - function MySQLPassword(const AText: Ansistring) : Ansistring; +uses + DCPcrypt2; + function EncryptText(const AText: String; aHash: TDCP_hash) : String; + function MySQLPassword(const AText: Ansistring; aHash: TDCP_hash) : Ansistring; implementation uses SysUtils, - Variants, DCPsha1, DCPdes, - ConnectionsDmUnit; + Variants; 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; - ConnectionsDM.Hash.UpdateStr(AText); - ConnectionsDM.Hash.Final(Digest); - ConnectionsDM.Hash.Burn; - ConnectionsDM.Hash.Init; - ConnectionsDM.Hash.Update(Digest,20); - ConnectionsDM.Hash.Final(Digest); - ConnectionsDM.Hash.Burn; + aHash.Init; + aHash.UpdateStr(AText); + aHash.Final(Digest); + aHash.Burn; + aHash.Init; + aHash.Update(Digest,20); + aHash.Final(Digest); + aHash.Burn; for i:= 0 to 19 do Result := Result + AnsiString(IntToHex(Digest[i], 2)); end;