THTTPServerThread issue

[fjabouley]

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 !

[ASerge]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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