Recent

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

fjabouley

  • Full Member
  • ***
  • Posts: 128
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: 6109
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: 35
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: 35
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

  • Hero Member
  • *****
  • Posts: 532
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
Lazarus 2.0.2 64b on Debian LXDE 10

Cyrax

  • Hero Member
  • *****
  • Posts: 836
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: 461
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: 6109
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

  • Hero Member
  • *****
  • Posts: 532
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
Lazarus 2.0.2 64b on Debian LXDE 10

rvk

  • Hero Member
  • *****
  • Posts: 6109
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

  • Hero Member
  • *****
  • Posts: 532
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
Lazarus 2.0.2 64b on Debian LXDE 10

euMesmo

  • New Member
  • *
  • Posts: 12
Re: TFPHTTPServer in a thread
« Reply #11 on: July 17, 2019, 05:54:19 pm »
Good afternoon.
Searching the internet I found this forum.
I am developing a multiplatform application in Lazarus. This application creates html, css and javascript files which I want users to be able to preview on a web server.
I have tried what is proposed in this forum but I have a problem. How can I indicate, in my application, what is the path to show the files that the program creates?
Thank you for your work, time and attention.
Greetings.

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: TFPHTTPServer in a thread
« Reply #12 on: July 18, 2019, 12:28:31 am »
Make your program create a web page at some fixed point with links to the created fle?

Or if it's a CGI or similar just return a redirection.
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

euMesmo

  • New Member
  • *
  • Posts: 12
Re: TFPHTTPServer in a thread
« Reply #13 on: July 18, 2019, 12:48:02 am »
Hello lucamar, thank you for answering.
My program http://www.webardora.net, to make a preview, creates the files in a temporary folder that I then open with the default browser as a local file. Although the program has the possibility for the user to install a web server and indicate its path to create the files there and open them as "localhost" I would like to be able to do it from the same program without users having to install anything.

I have already tried the rvk solution but I am lost at the point that just as I can indicate a server port can also indicate the path to open html.

Thank you very much. Excuseme, english is not my language.

rvk

  • Hero Member
  • *****
  • Posts: 6109
Re: TFPHTTPServer in a thread
« Reply #14 on: July 18, 2019, 10:03:24 am »
... I would like to be able to do it from the same program without users having to install anything.
So the target computer doesn't have a browser? And you don't want to install or rely on an external browser?

In that case you shouldn't even need a TFPHTTPServer, because you don't even have a browser.
You would need to use some HTML-viewer component.
Like THtmlPort https://wiki.freepascal.org/THtmlPort or fpbrowser https://wiki.freepascal.org/fpbrowser

If the target computer does have a browser and you want to provide a webpage to that browser via localhost you can look at the example here:
https://wiki.freepascal.org/Light_Web_Server
« Last Edit: July 18, 2019, 10:08:44 am by rvk »

 

TinyPortal © 2005-2018