Changeset 311


Ignore:
Timestamp:
Jan 4, 2012, 2:27:19 PM (13 years ago)
Author:
chronos
Message:
  • Added: Support for handling POST values in HTTPServer.
  • Fixed: TCP server to start listening and wait for termination.
  • Added: ServerType of WebApp as CGI or TCP.
Location:
Network/CoolWeb
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • Network/CoolWeb/Network/UTCPServer.pas

    r295 r311  
    3131
    3232  TClientThreadedPool = class(TThreadPool)
     33  protected
     34    function NewItemObject: TObject; override;
    3335  private
    3436    FActive: Boolean;
    … …  
    164166{ TClientThreadedPool }
    165167
     168function TClientThreadedPool.NewItemObject: TObject;
     169begin
     170  Result := TTCPClientThread.Create;
     171  TResetableThread(Result).OnException := ThreadException;
     172end;
     173
    166174procedure TClientThreadedPool.SetActive(const AValue: Boolean);
    167175begin

  • Network/CoolWeb/WebServer/UHTTPServer.pas

    r250 r311  
    2828
    2929  THTTPRequest = class
     30    ContentType: string;
     31    Content: TMemoryStreamEx;
    3032    Query: TQueryParameterList;
    3133    QueryParts: TListString;
    … …  
    3436    Headers: TStringList;
    3537    Cookies: TCookieList;
     38    Post: TQueryParameterList;
     39    procedure Clear;
    3640    constructor Create;
    3741    destructor Destroy; override;
    … …  
    4246  THTTPResponse = class
    4347    ContentType: string;
    44     Stream: TMemoryStreamEx;
     48    Content: TMemoryStreamEx;
    4549    Headers: TStringList;
    4650    Cookies: TCookieList;
     51    procedure Clear;
    4752    constructor Create;
    4853    destructor Destroy; override;
    … …  
    126131  I: Integer;
    127132begin
    128   with HandlerData, Response.Stream do begin
     133  with HandlerData, Response.Content do begin
    129134    //Response.Cookies.Values['Test'] := 'Halo';
    130135    //Response.Cookies.Values['Test2'] := 'Halo2';
    … …  
    134139
    135140    WriteString('<a href="?ServerInfo">Refresh</a>');
     141
     142    WriteString('<h5>Request HTTP content:</h5>');
     143    WriteStream(Request.Content, Request.Content.Size);
    136144
    137145    WriteString('<h5>Request HTTP headers</h5>');
    … …  
    151159    end;
    152160
     161    WriteString('<h5>Request HTTP POST</h5>');
     162    for I := 0 to Request.Post.Count - 1 do begin;
     163      WriteString(Request.Post.Strings[I] + '<br/>');
     164    end;
     165
     166
     167    WriteString('<h5>Response HTTP content:</h5>');
     168    WriteStream(Response.Content, Response.Content.Size);
     169
    153170    WriteString('<h5>Response HTTP headers</h5>');
    154     with Response.Stream do
     171    with Response.Content do
    155172    for I := 0 to Response.Headers.Count - 1 do begin;
    156173      WriteString(Response.Headers.Strings[I] + '<br/>');
    … …  
    166183procedure THTTPServer.ErrorResponse(HandlerData: THTTPHandlerData);
    167184begin
    168   with HandlerData, Response.Stream do begin
     185  with HandlerData, Response.Content do begin
    169186    WriteString('<html><body>' + Format(SPageNotFound, [Request.Path]) + '</body></html>');
    170187  end;
    … …  
    193210      Response.Headers.Values['Content-Type'] := GetMIMEType(Copy(ExtractFileExt(FileName), 2, 255));
    194211      BinaryFile := TFileStream.Create(FileName, fmOpenRead);
    195       Response.Stream.WriteStream(BinaryFile, BinaryFile.Size);
     212      Response.Content.WriteStream(BinaryFile, BinaryFile.Size);
    196213      BinaryFile.Destroy;
    197214    end else
    198     with Response.Stream do begin
     215    with Response.Content do begin
    199216      WriteLn(Format(SFileNotFound, [Request.Path]));
    200217      WriteString('<html><body>' + Format(SFileNotFound, [Request.Path]) + '</body></html>');
    … …  
    217234{ THTTPResponse }
    218235
     236procedure THTTPResponse.Clear;
     237begin
     238  Content.Clear;
     239  Cookies.Clear;
     240  Headers.Clear;
     241end;
     242
    219243constructor THTTPResponse.Create;
    220244begin
    221   Stream := TMemoryStreamEx.Create;
     245  Content := TMemoryStreamEx.Create;
    222246  Cookies := TCookieList.Create;
    223247  Headers := TStringList.Create;
    … …  
    226250destructor THTTPResponse.Destroy;
    227251begin
    228   Stream.Free;
     252  Content.Free;
    229253  Headers.Free;
    230254  Cookies.Free;
    … …  
    253277{ THTTPRequest }
    254278
     279procedure THTTPRequest.Clear;
     280begin
     281  Post.Clear;
     282  Content.Clear;
     283  QueryParts.Clear;
     284  Cookies.Clear;
     285  Headers.Clear;
     286  Query.Clear;
     287end;
     288
    255289constructor THTTPRequest.Create;
    256290begin
     291  Post := TQueryParameterList.Create;
    257292  Query := TQueryParameterList.Create;
    258293  QueryParts := TListString.Create;
    259294  Headers := TStringList.Create;
    260295  Cookies := TCookieList.Create;
     296  Content := TMemoryStreamEx.Create;
    261297end;
    262298
    263299destructor THTTPRequest.Destroy;
    264300begin
     301  Content.Free;
     302  Post.Free;
    265303  Query.Free;
    266304  QueryParts.Free;

  • Network/CoolWeb/WebServer/UHTTPServerCGI.pas

    r237 r311  
    66
    77uses
    8   Classes, SysUtils, UHTTPServer, SpecializedList;
     8  Classes, SysUtils, UHTTPServer, SpecializedList, IOStream;
    99
    1010type
    … …  
    5353  I: Integer;
    5454  HandlerData: THTTPHandlerData;
     55  InputStream: TIOStream;
     56  Line: string;
     57  Buffer: string;
     58  Count: Integer;
    5559begin
    5660  HandlerData := THTTPHandlerData.Create;
    5761  with HandlerData do try
     62    // Load headers
     63    try
     64      InputStream := TIOStream.Create(iosInput);
     65      SetLength(Buffer, 1000);
     66      repeat
     67        Count := InputStream.Read(Buffer[1], Length(Buffer));
     68        if Count > 0 then Request.Content.Write(Buffer[1], Count);
     69      until Count = 0;
     70    finally
     71      InputStream.Free;
     72    end;
     73
     74    //repeat
     75    //  ReadLn(Line);
     76    //until Line = '';
     77
     78    // Load data
     79    (*if Request.Headers.IndexOfName('Content-length') <> -1 then
     80    try
     81      InputStream := TIOStream.Create(iosInput);
     82      Request.Content.CopyFrom(InputStream, StrToInt(Request.Headers.Values['Content-length']));
     83    finally
     84      InputStream.Free;
     85    end;  *)
     86
    5887    // Load environment variables
    5988    for I := 0 to GetEnvironmentVariableCount - 1 do begin
    … …  
    80109      SessionStorage.Load(HandlerData);
    81110
    82     Response.Stream.Clear;
     111    // Load post data
     112    if EnvVars.IndexOfName('REQUEST_METHOD') <> -1 then begin
     113      if EnvVars.Values['REQUEST_METHOD'] = 'POST' then begin
     114        Request.Content.Position := 0;
     115        Buffer := Request.Content.ReadString;
     116        Request.Post.Parse(Buffer);
     117      end;
     118    end;
     119
     120    Response.Content.Clear;
    83121    Response.Headers.Values['Content-type'] := 'text/html';
    84122
    … …  
    105143
    106144      // Emit page content
    107       Stream.Position := 0;
    108       WriteLn(Stream.ReadString);
     145      Content.Position := 0;
     146      WriteLn(Content.ReadString);
    109147    end;
    110148  finally
    … …  
    118156begin
    119157  inherited;
    120   with HandlerData, Response.Stream do begin
     158  with HandlerData, Response.Content do begin
    121159    WriteString('<h5>' + SEnvironmentVariables + '</h5>');
    122160    WriteString('<table border="1">');

  • Network/CoolWeb/WebServer/UHTTPServerTCP.pas

    r237 r311  
    2121    constructor Create(AOwner: TComponent); override;
    2222    destructor Destroy; override;
     23    procedure Run; override;
    2324  published
    2425    property MaxConnection: Integer read FMaxConnection write FMaxConnection;
    … …  
    8889      SessionStorage.Load(HandlerData);
    8990
    90     Response.Stream.Clear;
     91    Response.Content.Clear;
    9192    Response.Headers.Values['Content-Type'] := 'text/html';
    9293
    … …  
    100101    with Response do begin
    101102      SendString('HTTP/1.0 200 OK'#13#10);
    102       Headers.Values['Content-Length'] := IntToStr(Stream.Size);
     103      Headers.Values['Content-Length'] := IntToStr(Content.Size);
    103104      Headers.Values['Connection'] := 'close';
    104105      Headers.Values['Date'] := RFC822DateTime(Now);
    … …  
    115116      end;
    116117      SendString(#13#10);
    117       SendBuffer(Stream.Memory, Stream.Size);
     118      SendBuffer(Content.Memory, Content.Size);
    118119      SendString(#13#10);
    119120    end;
    … …  
    143144end;
    144145
     146procedure THTTPServerTCP.Run;
     147begin
     148  inherited Run;
     149  WriteLn('HTTP Server started in TCP mode.');
     150  WriteLn('Listen on ' + Socket.Address + ':' + IntToStr(Socket.Port));
     151  WriteLn('Press any key to terminate...');
     152  Socket.ThreadPool.TotalCount := MaxConnection;
     153  Socket.Active := True;
     154  ReadLn;
     155  WriteLn('Exiting');
     156end;
     157
    145158end.
    146159

  • Network/CoolWeb/WebServer/UWebApp.pas

    r259 r311  
    77uses
    88  Classes, SysUtils, CustApp, SpecializedList, UWebPage, UHTTPSessionFile,
    9   UHTTPServer, UHTTPServerCGI;
     9  UHTTPServer;
    1010
    1111type
     12  THTTPServerType = (stCGI, stTCP);
     13
    1214  TRegistredPage = class
    1315    Name: string;
    … …  
    2527  TWebApp = class(TCustomApplication)
    2628  private
     29    FOnBeforePageProduce: TOnProduceEvent;
    2730    FOnInitialize: TNotifyEvent;
     31    FServerType: THTTPServerType;
    2832    procedure DoRun; override;
    2933    function DumpExceptionCallStack(E: Exception): string;
    3034    procedure HTTPServerRequest(HandlerData: THTTPHandlerData);
     35    procedure SetServerType(AValue: THTTPServerType);
    3136  public
    3237    Pages: TRegistredPageList;
    … …  
    3843    constructor Create(AOwner: TComponent); override;
    3944    destructor Destroy; override;
     45    property OnBeforePageProduce: TOnProduceEvent read FOnBeforePageProduce write FOnBeforePageProduce;
    4046    property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
     47    property ServerType: THTTPServerType read FServerType write SetServerType;
    4148  end;
    4249
    … …  
    4956
    5057implementation
     58
     59uses
     60  UHTTPServerCGI, UHTTPServerTCP;
    5161
    5262resourcestring
    … …  
    125135    //Request.QueryParts[0] := 'uzivatel';
    126136    //Request.QueryParts[1] := 'prihlaseni';
     137    if Assigned(FOnBeforePageProduce) then
     138      FOnBeforePageProduce(HandlerData);
    127139
    128140    if Request.QueryParts.Count > 0 then PageName := Request.QueryParts[0]
    … …  
    131143    if Assigned(Page) then begin
    132144      Page.Page.OnProduce(HandlerData);
    133     end else Response.Stream.WriteString(SPageNotFound);
    134   end;
     145    end else Response.Content.WriteString(SPageNotFound);
     146  end;
     147end;
     148
     149procedure TWebApp.SetServerType(AValue: THTTPServerType);
     150begin
     151  if FServerType = AValue then Exit;
     152  FServerType := AValue;
     153  HTTPServer.Free;
     154  case FServerType of
     155    stCGI: HTTPServer := THTTPServerCGI.Create(nil);
     156    stTCP: HTTPServer := THTTPServerTCP.Create(nil);
     157  end;
     158  HTTPServer.OnRequest := HTTPServerRequest;
    135159end;
    136160
    … …  
    152176    hstdout := @stderr;
    153177    Writeln(hstdout^, 'An unhandled exception occurred: ' + E.Message + '<br>');
    154     WriteLn(hstdout^, StringReplace(DumpExceptionCallStack(E), LineEnding, '<br>', [rfReplaceAll]));
     178    WriteLn(hstdout^, DumpExceptionCallStack(E));
    155179  end;
    156180end;
Note: See TracChangeset for help on using the changeset viewer.