* * *

Author Topic: TFPHTTPServer in a thread  (Read 1176 times)

jabounet

  • New member
  • *
  • Posts: 29
TFPHTTPServer in a thread
« on: March 12, 2017, 08:11:43 pm »



Hello all !


I'm trying to put a http server in my program to handle simple http requests.
To do that I used this example http://forum.lazarus.freepascal.org/index.php/topic,32353.msg208620.html#msg208620, using fhttpserver library.


Everything works fine, but I got an issue freeing the Server, and a memory leak is present.


Here is an example :


Code: Pascal  [Select]
  1. unit Unit1;
  2.  
  3.  
  4. {$mode objfpc}{$H+}
  5.  
  6.  
  7. interface
  8.  
  9.  
  10. uses
  11.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  12.   fphttpserver, fpHTTP, fpWeb;
  13.  
  14.  
  15. type
  16.  
  17.  
  18.   { TForm1 }
  19.  
  20.  
  21.   TForm1 = class(TForm)
  22.     Button1: TButton;
  23.     Button2: TButton;
  24.     procedure Button1Click(Sender: TObject);
  25.     procedure Button2Click(Sender: TObject);
  26.     procedure FormDestroy(Sender: TObject);
  27.   private
  28.     { private declarations }
  29.   public
  30.     { public declarations }
  31.      procedure DoHandleRequest(Sender:TObject; var ARequest:TFPHTTPConnectionRequest; var AResponse:TFPHTTPConnectionResponse);
  32.  
  33.  
  34.   end;
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.    { THTTPServerThread }
  42.  
  43.  
  44.    THTTPServerThread = class(TThread)
  45.    Private
  46.      Fserver : TFPHTTPServer;
  47.    Public
  48.      Constructor Create(APort:Word; const OnRequest:THTTPServerRequestHandler);
  49.      Procedure Execute; Override;
  50.      Procedure DoTerminate; Override;
  51.      Property Server : TFPHTTPServer Read FServer;
  52.    end;
  53.  
  54.  
  55.  var
  56.    Form1: TForm1;
  57.    FServerThread:TFPHTTPServer;
  58.  
  59.  
  60. implementation
  61.  
  62.  
  63. {$R *.lfm}
  64.  
  65.  
  66.  
  67.  
  68. procedure TForm1.DoHandleRequest(Sender: TObject;
  69.   var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);
  70. begin
  71.  showmessage( ARequest.QueryString);
  72. end;
  73.  
  74.  
  75. procedure TForm1.Button1Click(Sender: TObject);
  76. begin
  77.      FServerthread := THTTPServerThread.Create(8080,@DoHandleRequest);
  78.      FServerthread.Start;
  79. end;
  80.  
  81.  
  82. procedure TForm1.Button2Click(Sender: TObject);
  83. begin
  84.   FServerThread.Terminate;
  85. end;
  86.  
  87.  
  88. procedure TForm1.FormDestroy(Sender: TObject);
  89. begin
  90.     if Assigned(Fserverthread) then
  91.   begin
  92.     Fserverthread.Terminate;
  93.     Fserverthread.WaitFor;
  94.     FreeAndNil(Fserverthread);
  95.   end;
  96. end;
  97.  
  98.  
  99. constructor THTTPServerThread.Create(APort: Word;
  100.   const OnRequest: THTTPServerRequestHandler);
  101. begin
  102.   Inherited Create(True);
  103.   FServer := TFPHTTPServer.Create(Nil);
  104.      FServer.Threaded:=true;
  105.      FServer.Port := APort;
  106.      FServer.OnRequest := OnRequest;
  107.  
  108.  
  109. end;
  110.  
  111.  
  112. procedure THTTPServerThread.Execute;
  113. begin
  114.         try
  115.            FServer.Active:=true;
  116.            while not terminated do sleep(10);
  117.         finally
  118.            FreeAndNil(FServer);
  119.         end;
  120. end;
  121.  
  122.  
  123. procedure THTTPServerThread.DoTerminate;
  124. begin
  125.   inherited DoTerminate;
  126.   FServer.Active:=false;
  127. end;
  128.  
  129.  
  130.  
  131.  
  132. end.
  133.  
  134.  


I asked our god rvk and here is his answer :


Quote
Ok, the problem is the FServer.Active := true;
That just starts the listening server and execution stops until a response is received.
So it's essentially a loop itself so you can remove the while not terminated again.
You need to add the DoTerminate again to be able to stop the FServer.


But the problem is, that the DoTerminate is never executed in the thread anymore.
(you can see that by putting showmessages or breakpoints in the right places)


I'm not familiar with the TFPHTTPServer in a thread.
You could try to stop the server directory instead of calling Terminate but that didn't work for me either.


The main question is : How to stop correctly the thread/server ?


Thanks  !!!!


rvk

  • Hero Member
  • *****
  • Posts: 2558
Re: TFPHTTPServer in a thread
« Reply #1 on: March 12, 2017, 10:19:04 pm »
Additionally we tried this:
Code: Pascal  [Select]
  1. procedure TForm1.Button2Click(Sender: TObject);
  2. begin
  3.   // FServerThread.Terminate;
  4.   FServerThread.FServer.Active := False;
  5. end;
to stop the FServer in the thread directly in the hope execution will continue in the execute-function of the thread but it didn't.

So, how does one stop the execution of TFPHTTPServer.Active := True; ?

russdirks

  • New member
  • *
  • Posts: 31
Re: TFPHTTPServer in a thread
« Reply #2 on: April 07, 2017, 12:20:03 am »
I'm also interested in a solution to this.  My code is very similar to the above.  Since there is no way to normally exit from the Execute method,  I try to stop the server using a public method that is called from the main program:

Code: Pascal  [Select]
  1.  
  2. procedure CServerThread.Execute;
  3. begin
  4.    m_owner.m_server.Active := true;     // this does not return until the server is deactivated
  5.    m_owner.LogMsg('server is inactive');
  6. end;
  7.  
  8.  
  9. procedure CHttpServer.stopServer;
  10. begin
  11.     m_server.Active := false;
  12. end;
  13.  

This produces an ESocketError : Could not accept a client connection on socket: 476, error 10038.

This is on Windows 10.
« Last Edit: April 07, 2017, 12:22:17 am by russdirks »

russdirks

  • New member
  • *
  • Posts: 31
Re: TFPHTTPServer in a thread
« Reply #3 on: April 07, 2017, 01:23:50 am »
Just tried my code on OSX and I was able to stop the server fine, so maybe it is a Windows thing.

tudi_x

  • Full Member
  • ***
  • Posts: 201
Re: TFPHTTPServer in a thread
« Reply #4 on: July 17, 2017, 05:54:54 pm »
what are the options for Windows in this case? Synapse?

thank you

Cyrax

  • Hero Member
  • *****
  • Posts: 509
Re: TFPHTTPServer in a thread
« Reply #5 on: July 17, 2017, 10:24:27 pm »
what are the options for Windows in this case? Synapse?

thank you

AFAIK, same?

Blestan

  • Sr. Member
  • ****
  • Posts: 377
Re: TFPHTTPServer in a thread
« Reply #6 on: July 17, 2017, 10:50:01 pm »
take look on my ultramachine api backend... it not fully funtional yet but the multithreaded http server works and its stable and tested on win 10 and debian 8.4
Speak postscript or die!
Translate to pdf and live!

rvk

  • Hero Member
  • *****
  • Posts: 2558
Re: TFPHTTPServer in a thread
« Reply #7 on: July 18, 2017, 10:36:14 am »
what are the options for Windows in this case? Synapse?
It seems that the latest version 1.8RC2 with FPC 3.1.1 can stop the server under Windows with FServer.Active := False;

Do you have problems with it?

tudi_x

  • Full Member
  • ***
  • Posts: 201
Re: TFPHTTPServer in a thread
« Reply #8 on: July 18, 2017, 12:53:17 pm »
I have tested the attached project with Lazarus 1.8 RC3 and FPC 3.0.2.
I need to stay with FPC3.0.2 as this is for production module.
The stopping of the server does not occur when pressing the stop button.

Please advise why you would think is working with the FPC3.1.1 version?

thank you

rvk

  • Hero Member
  • *****
  • Posts: 2558
Re: TFPHTTPServer in a thread
« Reply #9 on: July 18, 2017, 01:09:25 pm »
Please advise why you would think is working with the FPC3.1.1 version?
I tested it and it worked :)

I do see some problems with your code.
DoTerminate is never executed for the thread. You might think that _t.Terminate will call _t.DoTerminate at some point but it doesn't (I'm not sure why but thread-expert might be able to explan that one).

I did the following to you code to get it working:
- move Server variable in thread to public (we need to call it directly to stop the server)
- you could also create a terminate method for that (but I did it this way)
- set FreeOnTerminate to true
- move Server.Free; to destroy of the thread. Not in the execute. You create it in create() so free it in destroy.


http_listen looks like this:
Code: Pascal  [Select]
  1. unit http_listen;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, fphttpapp, fphttpserver;
  9.  
  10. type
  11.   THTTPServerThread = class(TThread)
  12.   private
  13.     _Error: string;
  14.   public
  15.     Server: TFPHTTPServer;
  16.     constructor Create(APort: word; const OnRequest: THTTPServerRequestHandler);
  17.     destructor Destroy; override;
  18.     procedure Execute; override;
  19.     property Error: string read _Error;
  20.   end;
  21.  
  22. implementation
  23.  
  24. constructor THTTPServerThread.Create(APort: word; const OnRequest: THTTPServerRequestHandler);
  25. begin
  26.   Server := TFPHTTPServer.Create(nil);
  27.   Server.Port := APort;
  28.   Server.OnRequest := OnRequest;
  29.   _Error := 'nil';
  30.   Self.FreeOnTerminate := true;
  31.   inherited Create(False);
  32. end;
  33.  
  34. destructor THTTPServerThread.Destroy;
  35. begin
  36.   Server.Free;
  37. end;
  38.  
  39. procedure THTTPServerThread.Execute;
  40. begin
  41.   try
  42.     Server.Active := True;
  43.   except
  44.     on E: Exception do
  45.     begin
  46.       _Error := E.Message;
  47.     end;
  48.   end;
  49. end;
  50.  
  51. end.
And main.pas looks like this:
Code: Pascal  [Select]
  1. unit main;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  9.   StdCtrls, http_listen, fphttpserver;
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     stop: TButton;
  14.     start: TButton;
  15.     Memo1: TMemo;
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure startClick(Sender: TObject);
  18.     procedure stopClick(Sender: TObject);
  19.     procedure onRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
  20.       var AResponse: TFPHTTPConnectionResponse);
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.   _t: THTTPServerThread;
  26.  
  27. implementation
  28.  
  29. {$R *.lfm}
  30. procedure TForm1.startClick(Sender: TObject);
  31. begin
  32.   start.Enabled := False;
  33.   _t := THTTPServerThread.Create(8001, @onRequest);
  34.   stop.Enabled := True;
  35. end;
  36.  
  37. procedure TForm1.FormCreate(Sender: TObject);
  38. begin
  39.   stop.Enabled := False;
  40. end;
  41.  
  42. procedure TForm1.stopClick(Sender: TObject);
  43. begin
  44.   stop.Enabled := False;
  45.   // _t.Terminate;
  46.   _t.Server.Active := False; // <-- _t is automatically freed
  47.   start.Enabled := True;
  48. end;
  49.  
  50. procedure TForm1.onRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
  51.   var AResponse: TFPHTTPConnectionResponse);
  52. begin
  53.   Memo1.Append('HTTP request');
  54. end;
  55.  
  56.  
  57. end.
This worked fine for me (Lazarus 18RC2 FPC 3.1.1).

tudi_x

  • Full Member
  • ***
  • Posts: 201
Re: TFPHTTPServer in a thread
« Reply #10 on: July 18, 2017, 01:23:50 pm »
worked beautifully.
i will try to make a wiki page with the LinkedIn Outh2 integration code you helped me.

thank you very much rvk

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus