linux-server-fix

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
+            <CustomOptions Value="-dCGI"/>
--dLOG
+            <OtherDefines Count="3">
--dCGI"/>
+              <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

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":[');
+          AResponse.Contents.add(',"values":[');
-          for i := 0 to fValues.Count-1 do
+          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;
+  (Owner as TMyCGIApp).Log(ALevel,Sender,msg);
-  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;
 end;
 
 procedure TMyCGIApp.LoadConfig;
@@ -222,12 +232,28 @@ end;
 function TMyCGIApp.InitializeWebHandler: TWebHandler;
 begin
   LoadConfig;
-  flogger.FileName:=LogFolder;
+  if assigned(flogger) then
-  flogger.Active:=true;
+    begin
-  flogger.Info('start');
+      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

lmsreport.ini

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

lmsreport.lpi

@@ -223,6 +223,9 @@
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+      </Debugging>
       <Options>
         <Win32>
           <GraphicApplication Value="True"/>

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

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,[]);
+  try
-  cmdDone := false;
+    LogQuery(0,edtRequest.Text,Keys.Lines,0,0,[]);
-  edtAnswer.Text := '';
+    cmdDone := false;
-  edtQValue.Text := '';
+    edtAnswer.Text := '';
-  StatusPanel.Caption := 'Ожидание';
+    edtQValue.Text := '';
-  retValues.Clear;
+    StatusPanel.Caption := 'Ожидание';
-  client.Start;
+    retValues.Clear;
+    client.Start;
+    client.WaitFor;
+
+  finally
+    client.free;
+  end;
 
 end;
 

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]));
+  log(mtExtra,format('ProcessMessage(%d) Param=%x, Answer=%s ',[code,Param,ACommand]));
-  terminate;
-  Owner.Terminate;
   (Owner as TClientMainThread).ProcessAnswer(mode,code,Param,ACommand,Values,intData,Data);
 end;
 

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;