rtcwsockhttpsrvprov.pas

Delphi快速开发Web Server

{
  "HTTP Server Provider (WinSock)" - Copyright (c) Danijel Tkalcec
  @html(<br>)

  Using TRtcWSockServerProvider to implement a HTTP Server provider.

  @exclude
}
unit rtcWSockHttpSrvProv;

{$INCLUDE rtcDefs.inc}

interface

uses
  Classes,
  SysUtils,

  rtcLog,
  rtcConn,
  rtcConnProv,

  rtcFastStrings,
  rtcWSockSrvProv;

type
  TRtcWSockHttpServerProvider = class(TRtcWSockServerProvider)
  private
    FOnInvalidRequest:TRtcEvent;

    FMaxHeaderSize:integer;
    FMaxRequestSize:integer;

    FRequest:TRtcServerRequest;
    FResponse:TRtcServerResponse;

    FRequestBuffer:TRtcHugeString;

    FRequestWaiting:boolean; // will be set when request is waiting to be read.

    FChunked:boolean;
    FChunkState:byte;

    FRequestLine:boolean; // request line received
    InBuffer:string; // data received, including HTTP header (header will be stripped when read)
    FHaveRequest:boolean; // request header accepted, receiving request data.
    LenToRead:int64; // number of bytes left to read from last Request

    LenToWrite:int64; // number of bytes to write out using inherited Write()
    LenToSend:int64; // number of bytes left to send out (DataOut event)
    FHeaderOut:boolean;

    procedure ClearRequest;

  public
    constructor Create; override;
    destructor Destroy; override;

    procedure TriggerDisconnect; override;
    procedure TriggerDataReceived; override;
    procedure TriggerDataSent; override;
    procedure TriggerDataOut; override;

    procedure TriggerInvalidRequest; virtual;
    procedure SetTriggerInvalidRequest(Event:TRtcEvent);

    procedure WriteHeader(SendNow:boolean=True); overload;
    procedure WriteHeader(const Header_Text:string; SendNow:boolean=True); overload;

    procedure Write(const ResultData:string; SendNow:boolean=True); override;

    // 1. On DataReceived, read client request info using this:
    function Read:string; override;

    property Request:TRtcServerRequest read FRequest write FRequest;
    property Response:TRtcServerResponse read FResponse write FResponse;

    property MaxRequestSize:integer read FMaxRequestSize write FMaxRequestSize;
    property MaxHeaderSize:integer read FMaxHeaderSize write FMaxHeaderSize;
    end;

implementation

const
  CRLF = #13#10;
  END_MARK = CRLF+CRLF;

{ TRtcWSockHttpServerProvider }

procedure TRtcWSockHttpServerProvider.SetTriggerInvalidRequest(Event: TRtcEvent);
  begin
  FOnInvalidRequest:=Event;
  end;

procedure TRtcWSockHttpServerProvider.TriggerInvalidRequest;
  begin
  if assigned(FOnInvalidRequest) then
    FOnInvalidRequest;
  end;

constructor TRtcWSockHttpServerProvider.Create;
  begin
  inherited;
  FRequestBuffer:=TRtcHugeString.Create;

  InBuffer:='';
  LenToWrite:=0;
  LenToSend:=0;
  FHeaderOut:=False;
  FRequestLine:=False;
  FRequest:=nil;
  FResponse:=nil;
  FChunked:=False;
  FChunkState:=0;
  end;

destructor TRtcWSockHttpServerProvider.Destroy;
  begin
  Enter;
  try
    FRequestBuffer.Free;

    InBuffer:='';
    LenToWrite:=0;
    LenToSend:=0;
    FRequestLine:=False;
    FHeaderOut:=False;
  finally
    Leave;
    end;
  inherited;
  end;

procedure TRtcWSockHttpServerProvider.ClearRequest;
  begin
  FRequestBuffer.Clear;

  FRequestLine:=False;
  FRequest.Clear;
  FResponse.Clear;
  LenToRead:=0;
  end;

procedure TRtcWSockHttpServerProvider.TriggerDisconnect;
  begin
  inherited;
  Enter;
  try
    FRequestBuffer.Clear;

    InBuffer:='';
    LenToWrite:=0;
    LenToSend:=0;
    FHeaderOut:=False;
    FRequestLine:=False;

    ClearRequest;
  finally
    Leave;
    end;
  end;

procedure TRtcWSockHttpServerProvider.TriggerDataReceived;
  var
    s,
    StatusLine,
    HeadStr:string;
    HeadLen,
    MyPos:integer;

  function HexToInt(s:string):integer;
    var
      i,len:integer;
      c:char;
    begin
    Result:=0;
    len:=length(s);
    i:=1;
    while len>0 do
      begin
      c:=s[len];
      if c in ['1'..'9'] then
        Result:=Result+i*(Ord(c)-Ord('0'))
      else if s[len] in ['A'..'F'] then
        Result:=Result+i*(Ord(c)-Ord('A')+10)
      else if s[len] in ['a'..'f'] then
        Result:=Result+i*(Ord(c)-Ord('a')+10);
      i:=i*16;Dec(len);
      end;
    end;

  procedure RequestError;
    begin
    FRequestLine:=False;
    Leave;
    try
      TriggerInvalidRequest;
    finally
      Enter;
      end;
    end;

  begin
  if Request.Complete and not Response.Done then
    begin
    if assigned(CryptPlugin) then
      begin
      Enter;
      try
        // Read string from buffer
        InBuffer:=InBuffer + inherited Read;

        if InBuffer='' then
          begin
          FRequestWaiting:=True;
          Exit;
          end
        else
          FRequestWaiting:=False;
      finally
        Leave;
        end;
      end
    else
      begin
      FRequestWaiting:=True;
      Exit;
      end;
    end
  else
    FRequestWaiting:=False;

  Enter;
  try
    // Read string from buffer
    InBuffer:=InBuffer + inherited Read;

    while InBuffer<>'' do
      begin

      if not FHaveRequest then // Don't have the header yet ...
        begin
        if not FRequestLine then
          begin
          MyPos:=Pos(CRLF,InBuffer);
          if (MaxRequestSize>0) and
             ( (MyPos>MaxRequestSize+1) or
               ((MyPos<=0) and (length(InBuffer)>MaxRequestSize+length(CRLF))) ) then
            begin
            ClearRequest;
            Request.FileName:=InBuffer;
            RequestError;
            Exit;
            end
          else if (MyPos>0) then
            begin
            ClearRequest;
            StatusLine:=Copy(InBuffer,1,MyPos-1);
            Delete(InBuffer,1,MyPos+length(CRLF)-1);

            MyPos:=Pos(' HTTP/', UpperCase(StatusLine));
            if MyPos<=0 then
              MyPos:=Pos(' HTTPS/', UpperCase(StatusLine));

            if MyPos<=0 then
              begin
              Request.FileName:=StatusLine;
              RequestError;
              Exit;
              end
            else
              begin
              Request.Started:=True;
              Request.Active:=True;

              // Request Method
              MyPos:=Pos(' ',StatusLine);
              if MyPos<=0 then
                begin
                Request.FileName:=StatusLine;
                RequestError;
                Exit;
                end;

              Request.Method:=Trim(Copy(StatusLine,1,MyPos-1));
              Delete(StatusLine,1,MyPos);

              // Request FileName
              MyPos:=Pos(' ',StatusLine);
              if MyPos<=0 then
                begin
                Request.FileName:=StatusLine;
                RequestError;
                Exit;
                end;

              Request.FileName:=Copy(StatusLine,1,MyPos-1);
              Delete(StatusLine,1,MyPos);

              // Request HTTP type
              MyPos:=Pos('/',StatusLine);
              if MyPos<=0 then
                begin
                RequestError;
                Exit;
                end;

              if Copy(StatusLine,MyPos+1,3)='1.0' then
                Request.Close:=True;

              MyPos:=Pos('?',Request.FileName);
              if MyPos>0 then
                begin
                Request.Query.Text:=Copy(Request.FileName,MyPos+1,length(Request.FileName)-MyPos);
                Request.FileName:=Copy(Request.FileName,1,MyPos-1);
                end
              else
                Request.Query.Clear;

              FRequestLine:=True;
              end;
            end;
          end;

        if FRequestLine then
          begin
          // See if we can get the whole header ...
          HeadLen:=Pos(CRLF, InBuffer);
          if HeadLen<>1 then
            HeadLen:=Pos(END_MARK, InBuffer);

          if HeadLen=1 then
            begin
            Delete(InBuffer,1,2);
            FHaveRequest:=True;
            end
          else if (MaxHeaderSize>0) and
             ( (HeadLen>MaxHeaderSize) or
               ((HeadLen<=0) and (length(InBuffer)>MaxHeaderSize+length(END_MARK))) ) then
            begin
            RequestError;
            Exit;
            end
          else if HeadLen>0 then
            begin
            // Separate header from the body
            HeadStr:=Copy(InBuffer, 1, HeadLen+length(END_MARK)-1);
            Delete(InBuffer,1,HeadLen+length(END_MARK)-1);

            FHaveRequest:=True;

            // Scan for all header attributes ...
            MyPos:=Pos(CRLF, HeadStr);
            while (MyPos>1) do // at least 1 character inside line
              begin
              StatusLine:=Copy(HeadStr,1,MyPos-1);
              Delete(HeadStr,1,MyPos+Length(CRLF)-1);

              MyPos:=Pos(':',StatusLine);