[SOLVED] What wrong with this inherited TThread class with
TFPHTTPServer?
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
Awesome Programmer · 2013-07-16 16:14

Here is the whole program.

Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls,
  fphttpserver, fpweb, fpwebfile;

type

  { TForm1 }

  TForm1 = class(TForm)
    Start: TButton;
    Stop: TButton;
    procedure StartClick(Sender: TObject);
    procedure StopClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    procedure DoHandleRequest(Sender:TObject; var
ARequest:TFPHTTPConnectionRequest; var
AResponse:TFPHTTPConnectionResponse);
  end;

  { THTTPServerThread }

  THTTPServerThread = class(TThread)
  Private
    Fserver : TFPHTTPServer;
  Public
    Constructor Create(APort:Word; const
OnRequest:THTTPServerRequestHandler);
    Procedure Execute; Override;
    Procedure DoTerminate; Override;
    Property Server : TFPHTTPServer Read FServer;
  end;

var
  Form1: TForm1;
  FServerThread:TThread;

implementation
{$R *.lfm}
{ TForm1 }

procedure TForm1.DoHandleRequest(Sender: TObject;
  var ARequest: TFPHTTPConnectionRequest; var AResponse:
TFPHTTPConnectionResponse);
begin
       AResponse.SendRedirect('http://www.cnn.com/');
end;

procedure TForm1.StartClick(Sender: TObject);
begin
     FServerthread := THTTPServerThread.Create(8080,@DoHandleRequest);
     FServerthread.Start;
end;

procedure TForm1.StopClick(Sender: TObject);
begin
     FServerThread.Terminate;
end;

{ THTTPServerThread }

constructor THTTPServerThread.Create(APort: Word;
  const OnRequest: THTTPServerRequestHandler);
begin
     FServer := TFPHTTPServer.Create(Nil);
     FServer.Threaded:=true;
     FServer.Port := APort;
     FServer.OnRequest := OnRequest;
    //Inherited Create(False)  This line raises a compiler error - too
many thread open or semophore is not set...

    //IF I call execute directly here, it will start the HTTP server,
but then the whole application hangs up or becomes unresponsive.
end;

procedure THTTPServerThread.Execute;
begin
        try
           FServer.Active:=true;
        finally
           FreeAndNil(FServer);
        end;
end;

procedure THTTPServerThread.DoTerminate;
begin
  inherited DoTerminate;
  FServer.Active:=false;
end;

end.
This is based on a tutorial online. I am basically creating a HTTP
server application with Lazarus that runs on its own thread. I
followed the tutorial to the TEETH. However, I am running into
problem. I can't seem to get the Thread started. So, it will start the
http server. Somehow the thread is not acting like a thread. Override
on Execute and DoTerminate don't seem to have any effect at all. So,
what am I doing wrong.

When I do explicitly call threads Execute procedure, http server does
start and you make a request from a webrowser and it does redirect you
to www.cnn.com.

This is a simple program - a form with two buttons start and stop
buttons.

----------------------------------------------------------------------
marcov · 2013-07-16 16:58

Code: [Select]        try
           FServer.Active:=true;
        finally
           FreeAndNil(FServer);
        end;

This sets the server active, and then immediately frees the server and
ends the thread.

----------------------------------------------------------------------
Awesome Programmer · 2013-07-16 18:06

Actually, according to the tutorial, it is supposed to set Fserver
Active to true and then wait. Then, when the Fserver is terminated, it
finally frees and Nils it.

What I don't understand is that when I start the thread
(FServerThread) as following, procedure Execute doesn't fire at all
when it should.

Code: [Select]FServerThread.Start;

----------------------------------------------------------------------
Dick, from the internet · 2013-07-16 19:50

THTTPServerThread is a descendent of TThread, so you need to
initialize it with the inherited Create(Suspended :boolean) 
constructor.  Adding this made it work as is should for me.

Code: [Select]constructor THTTPServerThread.Create(APort: Word;
  const OnRequest: THTTPServerRequestHandler);
begin
     inherited create(True);                                 
//<<<<-------------- Add this line
     FServer := TFPHTTPServer.Create(nil);
     FServer.Threaded:=true;
     FServer.Port := APort;
     FServer.OnRequest := OnRequest;

On linux, to see that it is listening for a connection I used:

$ sudo netstat -lptu

and it displays:
QuoteActive Internet connections (only servers)
Proto Recv-Q Send-Q Local Address           Foreign Address       
 State       PID/Program name   
tcp        0      0 *:sunrpc                *:*                      
                              LISTEN      1325/rpcbind       
tcp        0      0 *:webcache              *:*                      
                         LISTEN      9307/project1       <<<----------
server is working
tcp        0      0 *:ssh                   *:*                      
                                LISTEN      1342/sshd          
tcp        0      0 *:ipp                   *:*                      
                                 LISTEN      1974/cupsd         
      
etc........

  regards,
      geno

----------------------------------------------------------------------
Awesome Programmer · 2013-07-17 14:36

Hi Geno,

I am working with Lazarus 1.0.6 and fpc 2.6.0

I did add the line Code: [Select]inherited Create(True); and I get a
compiler error. Then, the program crashes. Take a look at the image I
attached. That's the error I am getting, when I add that line of code
and run the program.

Let me just say that HTTP server is working as expected but not the
thread class.

Any idea?

----------------------------------------------------------------------
Leledumbo · 2013-07-17 14:42

QuoteThen, the program crashes. Take a look at the image I
attached.Got cthreads TURNED ON in your PROGRAM's uses clause?

----------------------------------------------------------------------
Dick, from the internet · 2013-07-17 15:04

Exactly as Leledumbo says; you need to ensure you are using the
threads unit.  Removing it from mine gave the same error message.

Code: [Select]program project1;

{$mode objfpc}{$H+}
{$DEFINE UseCThreads}           //<<------------ add this line to your
project.lpi

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, Unit1
  { you can add units after this };

{$R *.res}

begin
  RequireDerivedFormResource := True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

  I am assuming you are using linux, as you did not add any amplifying
information to your earlier posts (OS/Laz/FPC versions etc)    I just
caught the addition of the Laz/FPC info after I posted this.


    regards,
        geno

----------------------------------------------------------------------
Awesome Programmer · 2013-07-17 15:20

Thanks Geno and Leledumbo.

I knew there is got to be some simple solution to my problem.

I made the changes accordingly per your suggestions and it is working
finally.

Thanks a lot for your help.