unit HttpSvr;

{==========================================================}
{                                                          }
{  unit HttpSvr                        12/11/2002          }
{                                                          }
{                                                          }
{  Proces HTTP serveru                                     }
{                                                          }
{  (C)2002, SofCon, Stresovicka 49, 160 00 Praha 6         }
{           Petr Cernin                                    }
{                                                          }
{==========================================================}

interface

{$I SETS.INC} { Nastaveni podmineneho prekladu }

{-------------------------------
{ StartHttpServer
{---
{ Spusteni procesu HTTP serveru
{ StopFlag je odkaz na promennou, jejiz nastaveni na True zpusobi
{ ukonceni cinnosti procesu serveru.
{---
{ Tuto funkci je potreba zavolat pri vytvareni procesu aplikace napr.
{ v tele hlavniho podprogramu.
}

procedure StartHttpServer( var StopFlag: Boolean );

implementation

uses
  {$ifdef CRT}
  Crt,
  {$endif}
  Strings,         { Knihovna pro praci s retezci typu PChar               }
  Kernel,          { Jadro realneho casu                                   }
  CoBase,
  CoEth01,         { Ovladac ethernetove karty IOETH01                     }
  CoInet,          { Pomocna knihovna pro vyvtvoreni TCP/IP zasobniku      }
  Http,            { Skelet HTTP serveru                                   }
  HttpData;        { Jednotka poskytujici data serveru                     }

const

  { Parametry HTTP serveru. Obvykle je potreba modifikovat
    pouze parametry cEthParams, cIpParams a cStatPri. }

  cHttpNetStackId   = '';   { Identifikator TCP/IP zasobniku               }

  {$ifdef VERPC}
  cHttpEthParams    = 'IOBASE=$300';  { Bazova adresa ethernetove karty    }
  {$endif}

  {$ifdef VERMC}
  cHttpEthParams    = 'IOBASE=$2300'; { Bazova adresa ethernetove karty    }
  {$endif}

  { Parametry TCP/IP zasobniku }
  cHttpIpParams     = 'IPADDR="192.168.1.211" NETMASK="255.255.255.0"';

  cHttpMaxSessions  = 2;    { Max pocet soucasne obsluhovanych HTTP seanci }
  cMaxReqSize       = 1024; { Maximalni delka pozadavku (B)                }
  cMaxRespSize      = 1024; { Maximalni delka odpovedi (B)                 }

  cHttpStackSize    = 4096; { Velikost zasobniku procesu                   }
  cHttpDynPri       = 254;  { Dynamicka priorita procesu                   }
  cHttpStatPri      = 100;  { Staticka priorita procesu                    }
  cHttpWaitCount    = 1;    { Pocet waitu mezi dvema tiky HTTP serveru     }


  {-------------------------------
  { HttpDataProvider
  {---
  { Funkce poskytujici data serveru
  {---
  { HttpDataProvider vola funkce z jednotky HttpData, ktere
  { poskytuji data jednotlivych stranek
  }

  function HttpDataProvider( Session: PHttpSession ): Boolean; far;
  begin

    with Session^.Request do
    begin
      { Podle typu metody rozhodneme, kterou tabulku pouzijeme }

      case Method of

        mtdGET:
        begin
          HttpDataProvider := HttpDispatchSegment( Session^.Request.Path,
                                GetDocument, Session );
        end;

      else
        { Nepodporovana metoda (jina nez GET) }
        with Session^.Response do
        begin
          StatusCode := HTE_METHOD_NOT_ALLOWED;
          { Odpoved je pripravena, nechame ji odeslat a tedy vratime True }
          HttpDataProvider := True;
        end;
      end;
    end;

  end;

  {-------------------------------
  { HttpErrorHandler
  {---
  { Funkce reagujici na chyby serveru
  {---
  { Tuto funkci si upravte podle potreby aplikace.
  }

  procedure HttpErrorHandler( Session: PHttpSession;
    const AText: string ); far;
  begin
    {$ifdef DISPLAY}
    if Session <> nil then
    begin
      WriteLn( 'Session: ', AText );
    end
    else begin
      WriteLn( 'Server: ', AText );
    end;
    {$else}
      { Zde by bylo napr. vhodne zapsat chybu do nejakeho archivu }
    {$endif}
  end;



  {-------------------------------
  { StartHttpServer
  {---
  { Spusteni procesu HTTP serveru
  { StopFlag je odkaz na promennou, jejiz nastaveni na True zpusobi
  { ukonceni cinnosti procesu serveru.
  {---
  { Tuto funkci je mozne volat v pri vytvareni procesu aplikace napr.
  { v tele hlavniho podprogramu.
  }

  procedure StartHttpServer( var StopFlag: Boolean );
  var
    HttpSvr : THttpServer;
    Status  : TCoStatus;

  begin
    { Inicializace TCP/IP zasobniku }
    Status := NetOpenStack( 'ETH01', cHttpEthParams, cHttpIpParams,
                            cHttpNetStackId );

    if Status <> CST_SUCCESS then
    begin
      { Chyba pri inicializaci TCP/IP zasobniku }
      HttpErrorHandler( nil, 'NetOpenStack() failed: ' +
                             CoStatusToStr( Status ) );
      Exit;
    end;

    { Inicializace instance HTTP serveru }
    HttpSvr.Init( cHttpMaxSessions, cHttpNetStackID,
                  cMaxReqSize, cMaxRespSize );

    { Funkce poskytujici data serveru }
    HttpSvr.DataProvider := HttpDataProvider;

    { Funkce reagujici na chyby serveru }
    HttpSvr.ErrorHandler := HttpErrorHandler;

    { Spusteni procesu HTTP serveru }

    Start( 'HttpSvr', cHttpStackSize, cHttpStatPri, cHttpDynPri); Exit;
    repeat
      if StopFlag then HttpSvr.Stop;
      Wait( cHttpWaitCount );
    until HttpSvr.Tick;

    { Uvolneni serveru z pameti }
    HttpSvr.Done;

    { Uvolneni TCP/IP zasobniku }
    NetCloseStack( cHttpNetStackId );
  end;

end.
