Recent

Author Topic: THTTPServerThread issue  (Read 775 times)

fjabouley

  • New Member
  • *
  • Posts: 36
THTTPServerThread issue
« on: June 29, 2019, 08:38:10 am »
Hello all,
It's been a while since I started this topic.
I recently had to use a httpserver again, but i'm facing an issue.
I used rvk code.




Code: Pascal  [Select]
  1.  
  2.  
  3. unit jvet_http;
  4.  
  5.  
  6. {$mode objfpc}{$H+}
  7.  
  8.  
  9. interface
  10.  
  11.  
  12. uses
  13.   Classes, SysUtils, fphttpserver, Dialogs;
  14.  
  15.  
  16.  
  17.  
  18. type
  19.   THTTPServerThread = class(TThread)
  20.   private
  21.     _Error: string;
  22.   public
  23.     Server: TFPHTTPServer;
  24.     constructor Create(APort: word);
  25.     destructor Destroy; override;
  26.     procedure Execute; override;
  27.     property Error: string read _Error;
  28.     procedure DoHandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest;
  29.       var AResponse: TFPHTTPConnectionResponse);
  30.   end;
  31.  
  32.  
  33. const
  34.   CRLF = #13#10;
  35.  
  36.  
  37. implementation
  38.  
  39.  
  40. uses unit1;
  41.  
  42.  
  43. procedure THTTPServerThread.DoHandleRequest(Sender: TObject;
  44.   var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);
  45. begin
  46.  
  47. showmessage(Arequest.URI);
  48. end;
  49.  
  50.  
  51.  
  52.  
  53. constructor THTTPServerThread.Create(APort: word);
  54. begin
  55.   Server := TFPHTTPServer.Create(nil);
  56.   Server.Port := APort;
  57.   Server.OnRequest := @Dohandlerequest;
  58.   _Error := 'nil';
  59.   Self.FreeOnTerminate := True;
  60.   inherited Create(False);
  61. end;
  62.  
  63.  
  64. destructor THTTPServerThread.Destroy;
  65. begin
  66.   Server.Free;
  67. end;
  68.  
  69.  
  70. procedure THTTPServerThread.Execute;
  71. begin
  72.   try
  73.     Server.Active := True;
  74.   except
  75.     on E: Exception do
  76.     begin
  77.       _Error := E.Message;
  78.     end;
  79.   end;
  80. end;
  81.  
  82.  
  83. end.
  84.  
  85.  
  86.  


- var Fserverthread : THTTPServerThread in the main unit as a global variable.


I start the server, using "FServerthread := THTTPServerthread.Create(StrToInt(HTTP_SERVER_PORT));" in the main unit
everything goes well, and requests are processed finely.
Then when I stop the server using
Fserverthread.Server.active := false;
The server stops and it's ok.


But when I start the server again by calling the same method (  FServerthread := THTTPServerthread.Create...), request are not processed ERR_CONNECTION REFUSED in chrome
Then when I try to stop the server again it raises a sigsegv exception (like if I was trying to free the server twice)


When I first stop the server with Fserverthread.Server.active := false, Fserverthread is still assigned.

Has someone encountered that issue ?

Thanks all !
« Last Edit: June 30, 2019, 11:00:18 pm by fjabouley »

ASerge

  • Hero Member
  • *****
  • Posts: 1392
Re: THTTPServerThread issue
« Reply #1 on: June 29, 2019, 12:03:20 pm »
When I first stop the server with Fserverthread.Server.active := false, Fserverthread is still assigned.
Has someone encountered that issue ?
Yes, it looks like the server loop does not terminate after "Active := False" until another request is received.
I've reworked your example a bit so other can try it:
Code: Pascal  [Select]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, StdCtrls, fphttpserver;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     btnStart: TButton;
  13.     btnStop: TButton;
  14.     Memo1: TMemo;
  15.     procedure btnStartClick(Sender: TObject);
  16.     procedure btnStopClick(Sender: TObject);
  17.     procedure FormCreate(Sender: TObject);
  18.   private
  19.     FThread: TThread;
  20.     procedure ThreadTerminated(Sender: TObject);
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. type
  31.   THTTPServerThread = class(TThread)
  32.   strict private
  33.     FServer: TFPHTTPServer;
  34.     FRequest: TFPHTTPConnectionRequest;
  35.     procedure DoHandleRequest(Sender: TObject;
  36.       var ARequest: TFPHTTPConnectionRequest;
  37.       var AResponse: TFPHTTPConnectionResponse);
  38.     procedure ShowRequest;
  39.   protected
  40.     procedure Execute; override;
  41.   public
  42.     constructor Create(APort: Word);
  43.     destructor Destroy; override;
  44.     procedure StopServer;
  45.   end;
  46.  
  47. { THTTPServerThread }
  48.  
  49. constructor THTTPServerThread.Create(APort: Word);
  50. begin
  51.   inherited Create(True);
  52.   FServer := TFPHttpServer.Create(nil);
  53.   FServer.Port := APort;
  54.   FServer.OnRequest := @DoHandleRequest;
  55.   FreeOnTerminate := True;
  56. end;
  57.  
  58. destructor THTTPServerThread.Destroy;
  59. begin
  60.   FServer.Free;
  61.   inherited;
  62. end;
  63.  
  64. procedure THTTPServerThread.DoHandleRequest(Sender: TObject;
  65.   var ARequest: TFPHTTPConnectionRequest;
  66.   var AResponse: TFPHTTPConnectionResponse);
  67. begin
  68.   FRequest := ARequest;
  69.   Synchronize(@ShowRequest);
  70.   FRequest := nil;
  71. end;
  72.  
  73. procedure THTTPServerThread.Execute;
  74. begin
  75.   FServer.Active := True;
  76. end;
  77.  
  78. procedure THTTPServerThread.ShowRequest;
  79. begin
  80.   if Assigned(Form1) and Assigned(FRequest) then
  81.     Form1.Memo1.Append(FRequest.URI);
  82. end;
  83.  
  84. procedure THTTPServerThread.StopServer;
  85. begin
  86.   FServer.Active := False;
  87. end;
  88.  
  89. { TForm1 }
  90.  
  91. procedure TForm1.btnStartClick(Sender: TObject);
  92. begin
  93.   if Assigned(FThread) then
  94.     Exit;
  95.   btnStart.Enabled := False;
  96.   FThread := THTTPServerThread.Create(7777);
  97.   FThread.OnTerminate := @ThreadTerminated;
  98.   Memo1.Append('Server thread started');
  99.   FThread.Start;
  100.   btnStop.Enabled := True;
  101. end;
  102.  
  103. procedure TForm1.ThreadTerminated(Sender: TObject);
  104. begin
  105.   FThread := nil;
  106.   Memo1.Append('Server thread stopped');
  107.   btnStart.Enabled := True;
  108.   btnStop.Enabled := False;
  109. end;
  110.  
  111. procedure TForm1.btnStopClick(Sender: TObject);
  112. begin
  113.   if Assigned(FThread) then
  114.     (FThread as THTTPServerThread).StopServer;
  115. end;
  116.  
  117. procedure TForm1.FormCreate(Sender: TObject);
  118. begin
  119.   btnStop.Enabled := False;
  120. end;
  121.  
  122. end.

fjabouley

  • New Member
  • *
  • Posts: 36
Re: THTTPServerThread issue
« Reply #2 on: July 02, 2019, 09:25:33 am »
Thx Aserge.


I can't manage to find out where is the issue...
I tried rvk's code from a previous post (he said it was working with FPC 3.1.x), but using it with FPC 3.0.2 and FPC 3.2.0 doesn't work.

ASerge

  • Hero Member
  • *****
  • Posts: 1392
Re: THTTPServerThread issue
« Reply #3 on: July 03, 2019, 06:53:55 pm »
I tried rvk's code from a previous post (he said it was working with FPC 3.1.x), but using it with FPC 3.0.2 and FPC 3.2.0 doesn't work.
Make a direct link to the post, because the "previous" is ambiguous.
I tried the same code on Lazarus 2.1.0, FPC 3.3.1 - the result is the same, i.e. the problem exists.

jamie

  • Hero Member
  • *****
  • Posts: 1899
Re: THTTPServerThread issue
« Reply #4 on: July 03, 2019, 11:00:03 pm »
Well I see a potential problem with that code..

Calling a member of the thread from out side that is interactively running internally within the
same class is most likely going to collide.

Also, how thread safe could that Server class really be?

In any case I wouldn't do it that way, I would use flags in the thread that get polled from the
thread code, call it a command state if you wish..

 When the thread code comes up for air it can check the command state and then act on it..
 
 Mean while the outside world should not set another state until the current state is cleared.

 This is called synchronizing a main thread with the secondary thread.  I am not talking about the
Thread talking to the main code but the other way round.

 So if you want to stop the server, set a flag in the thread body that gets check from the thread code when
it is ready to do so.. And then Call the STOP function of the server but do it within the Thread.

 I think you understand What I mean.

ASerge

  • Hero Member
  • *****
  • Posts: 1392
Re: THTTPServerThread issue
« Reply #5 on: July 03, 2019, 11:28:05 pm »
In any case I wouldn't do it that way, I would use flags in the thread that get polled from the
thread code, call it a command state if you wish..
This is of course correct, but how to do it with the existing implementation of "phphttpserver.pas". Only by rewriting it?

jamie

  • Hero Member
  • *****
  • Posts: 1899
Re: THTTPServerThread issue
« Reply #6 on: July 03, 2019, 11:49:55 pm »
In the Execute method, it should be in a loop testing for the terminate..

while in that loop, it can also test for other conditions..

ASerge

  • Hero Member
  • *****
  • Posts: 1392
Re: THTTPServerThread issue
« Reply #7 on: July 04, 2019, 02:58:03 pm »
In the Execute method, it should be in a loop testing for the terminate..
while in that loop, it can also test for other conditions..
Again. This is correct, but how to do it with the existing implementation of "phphttpserver.pas"? No state variable. Method does not return until someone somehow stops it from another thread.

jamie

  • Hero Member
  • *****
  • Posts: 1899
Re: THTTPServerThread issue
« Reply #8 on: July 04, 2019, 08:03:51 pm »
Its very painful to Select and Copy Code from the forums...

Although I can select exactly what I want, It wants brings along the line numbers at the left so it makes it
tedious to edit them out in any editor.


jamie

  • Hero Member
  • *****
  • Posts: 1899
Re: THTTPServerThread issue
« Reply #9 on: July 04, 2019, 08:58:06 pm »
I painfully typed it in...

If you set the OnAcceptIdlTimeout := 1; or something other than 0 it will time out in the loop to
test for things.

 Your example seems to work that way..

 
Code: Pascal  [Select]
  1. Constructor ThttpServerThread.Create(Aport:Word);
  2.   Begin
  3.     inherited Create(True);
  4.     fServer := TfphttpServer.Create(Nil);
  5.     FServer.Port := Aport;
  6.     FServer.AcceptIdleTimeout := 1;  // added but don't know what value 1 really is?
  7.     FServer.OnRequest := @DoHandleRequest;
  8.     FreeOnTerminate := True;
  9.   End;                      
  10.  

fjabouley

  • New Member
  • *
  • Posts: 36
Re: THTTPServerThread issue
« Reply #10 on: July 04, 2019, 11:01:27 pm »
Hi jamie
I tried your code with FPC 3.2 but unfortunately it didn't work :
- You can start / stop the server, and it's ok
- but when you start the server, make a http request, and then try to stop the sever, it won't stop correctly (with timeout set to 1)



jamie

  • Hero Member
  • *****
  • Posts: 1899
Re: THTTPServerThread issue
« Reply #11 on: July 05, 2019, 09:01:27 pm »
The value of 1 was just a number I put in there..

Try a larger value.. Like 1000, or 100. those are in mseconds.

select the max time you want to wait for a stop to responds and use that..

for example, 1000 = 1 second. that should give enough time between socket reads to complete a
session.

 Also, if you stop the server in the middle of a transaction what else would you expect?

fjabouley

  • New Member
  • *
  • Posts: 36
Re: THTTPServerThread issue
« Reply #12 on: July 05, 2019, 10:55:37 pm »
Jamie :
I tried larger values of course, but actually it doesn't work (in my case)
May you try with the code ASerge published and not only switch on/off the server but make real world http requests?
Regards

jamie

  • Hero Member
  • *****
  • Posts: 1899
Re: THTTPServerThread issue
« Reply #13 on: July 06, 2019, 02:13:03 am »
Yes it works for

Memo1
Server started
/
/favicon.ico
/
/favicon.ico
Server Thread Stopped
Server started
/index.html
Server Thread Stopped

These are the request I got from IE.
first couple was just a blank request.
the last one I requested the index.html and it got received..

 I had to use my local IP for the PC not the loop back 127.0.0.0
I don't know what else to tell  you.

Currently I have the timeout for  1000 = 1 sec...
I've done it with 10000 = 10 secs..

This is with Serges code setting the Timeout not yours...

fjabouley

  • New Member
  • *
  • Posts: 36
Re: THTTPServerThread issue
« Reply #14 on: July 06, 2019, 07:48:05 am »
jamie :
thx for the reply.
I'm gonna test out with latest version of lazarus (I installed beta one last time, perhaps it comes from that) and tell you if it works