linux-server-fix

2023-11-16 13:35:05 +03:00 · 2023-11-16 13:35:05 +03:00 · 6488e9c8b4
commit 6488e9c8b4
parent 30f2e6e918
8 changed files with 120 additions and 41 deletions
--- a/lms_cgi.lpi
+++ b/lms_cgi.lpi
@ -17,6 +17,9 @@
    <BuildModes>
      <Item Name="Default" Default="True"/>
      <Item Name="Debug">
+        <MacroValues Count="1">
+          <Macro1 Name="LCLWidgetType" Value="nogui"/>
+        </MacroValues>
        <CompilerOptions>
          <Version Value="11"/>
          <PathDelim Value="\"/>
@ -40,7 +43,6 @@
          <Linking>
            <Debugging>
              <DebugInfoType Value="dsDwarf3"/>
-              <UseHeaptrc Value="True"/>
              <TrashVariables Value="True"/>
              <UseExternalDbgSyms Value="True"/>
            </Debugging>
@ -53,6 +55,9 @@
        </CompilerOptions>
      </Item>
      <Item Name="Release">
+        <MacroValues Count="1">
+          <Macro2 Name="LCLWidgetType" Value="nogui"/>
+        </MacroValues>
        <CompilerOptions>
          <Version Value="11"/>
          <PathDelim Value="\"/>
@ -72,12 +77,19 @@
            <LinkSmart Value="True"/>
          </Linking>
          <Other>
-            <CustomOptions Value="-dDEBUG
-dLOG
-dCGI"/>
+            <CustomOptions Value="-dCGI"/>
+            <OtherDefines Count="3">
+              <Define0 Value="DEBUG"/>
+              <Define1 Value="LOG"/>
+              <Define2 Value="CGI"/>
+            </OtherDefines>
          </Other>
        </CompilerOptions>
      </Item>
+      <SharedMatrixOptions Count="2">
+        <Item1 ID="899046417212" Modes="Debug" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
+        <Item2 ID="755797817496" Modes="Release" Type="IDEMacro" MacroName="LCLWidgetType" Value="nogui"/>
+      </SharedMatrixOptions>
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
@ -88,6 +100,9 @@
    </RunParams>
    <RequiredPackages>
      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+      <Item>
        <PackageName Value="lnetbase"/>
      </Item>
      <Item>
@ -127,6 +142,11 @@
    <SearchPaths>
      <IncludeFiles Value="$(ProjOutDir)"/>
    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+      </Debugging>
+    </Linking>
    <Other>
      <CustomOptions Value="-dDEBUG
 -dLOG
--- a/lms_cgi.lpr
+++ b/lms_cgi.lpr
@ -3,6 +3,12 @@ program lms_cgi;
 {$mode objfpc}{$H+}

 uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
  Interfaces,  Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
   lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;

@ -38,12 +44,14 @@ Type
  Protected
   function InitializeWebHandler: TWebHandler; override;
  public
+   procedure Test;
   constructor CreateWithLogger(AOwner: TComponent);
   destructor Destroy; override;
   property Host: string read fHost;
   property Port: integer read fPort;
   property LogFolder: string read fLogFolder;
   property Logger: TEventLog read flogger;
+   procedure log(ALevel: TLogLevel; Sender: TObject; msg: string);
  end;

 const
@ -54,6 +62,7 @@ function TMyCGIHandler.answerReady(Sender: TMainThread; const mode: byte;
  const Values: TStrings; const iValues: TParamArray; const Data: TStream
  ): boolean;
 begin
+  log(mtExtra,self,'AnswerReady');
  fAnswer:=Answer;
  fMode:=mode;
  fCode:=code;
@ -69,7 +78,7 @@ begin
      Data.seek(0,soFromBeginning);
      fData.CopyFrom(Data,Data.Size);
    end;
-  Sender.Terminate;
+  log(mtExtra,self,'AnswerReady.done');
 end;

 procedure TMyCGIHandler.HandleRequest(ARequest: Trequest; AResponse: TResponse);
@ -110,7 +119,7 @@ log(mtDebug,self,'Command '+ARequest.Command);
  LogStrings(mtInfo, @log,self,'CookieFields',Arequest.CookieFields);
  LogStrings(mtInfo, @log,self,'CustomHeaders',Arequest.CustomHeaders);
 {$ENDIF}
-  if ARequest.QueryFields.Values['action']='cgi-test' then
+  if ARequest.QueryFields.Values['action']='' then
    begin
      AResponse.ContentType := 'text/html';
      AResponse.Contents.add('<h2>QueryFields</h2>');
@ -142,11 +151,20 @@ log(mtDebug,self,'Command '+ARequest.Command);
  try
  allfields.AddStrings(ARequest.QueryFields);
  allfields.AddStrings(ARequest.ContentFields);
+  log(mtDebug,self,'fields');
  clt := TClientMainThread.Create(ARequest.QueryFields.Values['action'],allfields,@Log,(Owner as TMyCGIApp).Host,(Owner as TMyCGIApp).Port,@answerReady);
+  try
+  log(mtExtra,self,'create thread');
  clt.start;
+  log(mtExtra,self,'thread started');
  clt.waitFor;

  finally
+     log(mtExtra,self,'thread finished');
+     clt.free;
+  end;
+
+  finally
     allfields.free;
  end;
  {$IFDEF DEBUG}
@ -165,13 +183,15 @@ log(mtDebug,self,'Data READY');
      AResponse.Contents.add('"type":'+aTypes[fMode]+',');
      AResponse.Contents.add('"code":'+inttostr(fCode)+',');
      AResponse.Contents.add('"value":'+inttostr(fParam)+',');
-      AResponse.Contents.add('"name":"'+(fAnswer)+'",');
+      AResponse.Contents.add('"name":"'+(fAnswer)+'"');
      if assigned(fValues) then
        begin
-          AResponse.Contents.add('"values":[');
-          for i := 0 to fValues.Count-1 do
+          AResponse.Contents.add(',"values":[');
+          if fValues.count>0 then
+            AResponse.Contents.Add(fValues[0]);
+          for i := 1 to fValues.Count-1 do
            begin
-              AResponse.Contents.Add(fValues[i]+',');
+              AResponse.Contents.Add(','+fValues[i]);
            end;
          AResponse.Contents.add(']');
          fValues.Free;
@ -191,18 +211,8 @@ log(mtDebug,self,'Data READY');
 end;

 procedure TMyCGIHandler.log(ALevel: TLogLevel; Sender: TObject; msg: string);
-var
-  f: TextFile;
-  s: string;
 begin
-  if (Owner as TMyCGIApp).Logger=nil then exit;
-  case ALevel of
-    mtError: (Owner as TMyCGIApp).Logger.Error(msg);
-    mtWarning: (Owner as TMyCGIApp).Logger.Warning(msg);
-    mtInfo: (Owner as TMyCGIApp).Logger.Info(msg);
-    mtDebug: (Owner as TMyCGIApp).Logger.Debug(msg);
-    mtExtra: (Owner as TMyCGIApp).Logger.Log(msg);
-  end;
+  (Owner as TMyCGIApp).Log(ALevel,Sender,msg);
 end;

 procedure TMyCGIApp.LoadConfig;
@ -222,12 +232,28 @@ end;
 function TMyCGIApp.InitializeWebHandler: TWebHandler;
 begin
  LoadConfig;
-  flogger.FileName:=LogFolder;
-  flogger.Active:=true;
-  flogger.Info('start');
+  if assigned(flogger) then
+    begin
+      flogger.FileName:=LogFolder;
+      flogger.Active:=true;
+      flogger.Info('start');
+    end;
  Result:=TMyCgiHandler.Create(self);
 end;

+procedure TMyCGIApp.Test;
+var
+  clt: TClientMainThread;
+begin
+  clt := TClientMainThread.Create('reports',nil,@Log,'10.120.7.20',6543,nil);
+  try
+  clt.start;
+  clt.waitFor;
+  finally
+     clt.free;
+  end;
+end;
+
 constructor TMyCGIApp.CreateWithLogger(AOwner: TComponent);
 begin
  flogger := TEventLog.Create(self);
@ -239,10 +265,24 @@ end;

 destructor TMyCGIApp.Destroy;
 begin
-  flogger.free;
+  if assigned(flogger) then
+    FreeAndNil(flogger);
  inherited Destroy;
 end;

+procedure TMyCGIApp.log(ALevel: TLogLevel; Sender: TObject; msg: string);
+begin
+  if Logger=nil then exit;
+  case ALevel of
+    mtError: Logger.Error(msg);
+    mtWarning: Logger.Warning(msg);
+    mtInfo: Logger.Info(msg);
+    mtDebug: Logger.Debug(msg);
+    {$IFDEF DEBUG} mtExtra: Logger.Log(msg); {$ENDIF}
+  end;
+
+end;
+


 begin
--- a/lmsreport.ini
+++ b/lmsreport.ini
@ -4,4 +4,4 @@ port=7079
 database=lms
 [PARAMS]
 port=6543
-log=D:\PROJECTS\LAZARUS\LMS\out\server.log
+log=server.log
--- a/lmsreport.lpi
+++ b/lmsreport.lpi
@ -223,6 +223,9 @@
      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
    </SearchPaths>
    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+      </Debugging>
      <Options>
        <Win32>
          <GraphicApplication Value="True"/>
--- a/maintcpserver.lfm
+++ b/maintcpserver.lfm
@ -8,7 +8,7 @@ object CGIServerGUI: TCGIServerGUI
  ClientWidth = 870
  OnCreate = FormCreate
  OnDestroy = FormDestroy
-  LCLVersion = '2.2.0.4'
+  LCLVersion = '2.2.2.0'
  object Panel1: TPanel
    Left = 0
    Height = 50
--- a/maintcpserver.pas
+++ b/maintcpserver.pas
@ -90,13 +90,19 @@ procedure TCGIServerGUI.SendButtonClick(Sender: TObject);
 begin
  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;
-  edtAnswer.Text := '';
-  edtQValue.Text := '';
-  StatusPanel.Caption := 'Ожидание';
-  retValues.Clear;
-  client.Start;
+  try
+    LogQuery(0,edtRequest.Text,Keys.Lines,0,0,[]);
+    cmdDone := false;
+    edtAnswer.Text := '';
+    edtQValue.Text := '';
+    StatusPanel.Caption := 'Ожидание';
+    retValues.Clear;
+    client.Start;
+    client.WaitFor;
+
+  finally
+    client.free;
+  end;

 end;

--- a/tcpclient.pas
+++ b/tcpclient.pas
@ -48,6 +48,7 @@ implementation

 procedure TClientMainThread.SynchAnswer;
 begin
+  log(mtExtra,self,'SynchAnswer');
  if assigned(fOnComplete) then
    fOnComplete(self,fmode,fResult.code,fResult.Param,fResult.Name,fResult.Keys,fResult.iValues,fResult.Data);
 end;
@ -56,7 +57,7 @@ constructor TClientMainThread.Create(ACommand: string; AFields: TStrings;
  ALogger: TLogger; AHost: string; APort: integer; OnReceive: TRequestComplete);
 begin
  inherited Create(TClientThread,ALogger,APort);
-  FreeOnTerminate:=true;
+  FreeOnTerminate:=false;
  fOnComplete:=onReceive;
  Connect.OnConnect:=@doConnect;
  fCommand := ACommand;
@ -80,11 +81,16 @@ begin
  doStart;
  log(mtExtra, self,'start main thread');
  Connect.Connect(Host,Port);
+  try
  while not terminated and not Complete do
    begin
    Connect.CallAction;
    sleep(10);
    end;
+
+  finally
+    log(mtExtra,self,'main thread terminated');
+  end;
  TerminateClients;
  Connect.Disconnect();
  log(mtExtra, self,'terminated');
@ -99,6 +105,7 @@ procedure TClientMainThread.ProcessAnswer(const mode: byte; const Code: DWORD;
  const QValue: QWORD; const Answer: string; const Values: TStrings;
  const iValues: TParamArray; const Data: TStream);
 begin
+  log(mtExtra,self,'ProcessAnswer '+Answer);
  try
  if assigned(fOnComplete) then
    begin
@ -108,7 +115,7 @@ begin


    end;
-
+    SetComplete;
  except on e:Exception do
    begin
      log(mtError, self,'!!ERROR  ProcessAnswer '+e.message);
@ -126,9 +133,7 @@ procedure TClientThread.ProcessMessage(const mode: byte; const Code: DWORD;
  const Param: QWord; const ACommand: string; const Values: TStrings;
  const intData: TParamArray; const Data: TStream);
 begin
-  log(mtDebug,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand]));
-  terminate;
-  Owner.Terminate;
+  log(mtExtra,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand]));
  (Owner as TClientMainThread).ProcessAnswer(mode,code,Param,ACommand,Values,intData,Data);
 end;

--- a/tcpthreadhelper.pas
+++ b/tcpthreadhelper.pas
@ -259,6 +259,7 @@ end;

 procedure TMainThread.TerminatedSet;
 begin
+  log(mtExtra,self,'terminated required');
  inherited TerminatedSet();

 end;
@ -293,6 +294,8 @@ end;

 destructor TMainThread.Destroy;
 begin
+  log(mtExtra,self,'Destroy');
+  TerminateClients;
  fClients.Free;
  fCon.Free;
  Inherited Destroy;
@ -300,6 +303,7 @@ end;

 procedure TMainThread.SetComplete;
 begin
+  log(mtExtra,self,'setcomplete');
  fComplete:=true;
 end;

@ -1041,8 +1045,8 @@ end;

 destructor TConnectionThread.Destroy;
 begin
+  log(mtExtra,'destroy');
  fCache.Free;
-  fOwner.removeClient(self);
  inherited Destroy;
 end;

@ -1084,6 +1088,7 @@ begin
      end;
    end;
  Cache.Close;
+  log(mtExtra,'terminated');
  //Socket.Disconnect();
 end;

@ -1091,7 +1096,7 @@ procedure TConnectionThread.TerminatedSet;
 begin
  log(mtExtra,'terminate required');
  Cache.Close;
-  fOwner.removeClient(self);
+
 end;