unit Sparkle.Http.InProcEngine;

{$I Sparkle.Inc}

interface

uses
  System.SysUtils,
  System.Classes,
  Sparkle.Http.Engine,
  Sparkle.Http.Headers,
  Sparkle.InProc.Context,
  Sparkle.InProc.Server,
  Sparkle.Uri;

type
  TInProcHttpResponse = class;
  THttpChunkedReader = class;

  TInProcHttpResponseStream = class(THttpResponseStream)
  strict private
    FStream: TStream;
    FChunkedReader: THttpChunkedReader;
  strict protected
    function HttpRead(var Buffer; Count: Longint): Longint; override;
  public
    constructor Create(AStream: TStream; AChunked: Boolean);
    destructor Destroy; override;
  end;

  THttpChunkedReader = class
  strict private
    type TChunkReadState = (ReadingSize);
  strict private
    FStream: TStream;
    FRemainingInChunk: Longint;
    FFinished: Boolean;
    procedure ReadCRLF; inline;
    function ReadByte: Byte; inline;
    function ReadChunkSize: Longint;
  public
    constructor Create(AStream: TStream);
    function Read(var Buffer; Count: Longint): Longint;
  end;

  TInProcHttpResponse = class(THttpResponse)
  strict private
    FContext: TInProcHttpContext;
    FContentLength: Int64;
    FContentLengthLoaded: boolean;
  protected
    function GetContentLength: Int64; override;
    function CreateContentStream: TStream; override;
    function GetContentType: string; override;
    function GetContentEncoding: string; override;
    function GetStatusCode: integer; override;
    function GetStatusReason: string; override;
    procedure UpdateHeaders(AHeaders: THttpHeaders); override;
  public
    constructor Create(AContext: TInProcHttpContext);
    destructor Destroy; override;
  end;

  TInProcHttpEngine = class(THttpEngine)
  strict protected
    function DoCreateRequest: THttpRequest; override;
    function DoSend(Request: THttpRequest): THttpResponse; override;
  public
    constructor Create; override;
    destructor Destroy; override;
  end;

  EChunkedException = class(Exception)
  end;

  EChunkedExpectedDataException = class(EChunkedException)
  public
    constructor Create(Position: Integer);
  end;

  EChunkedExpectedCRLFException = class(EChunkedException)
  public
    constructor Create(Position: Integer);
  end;

  EChunkedInvalidSizeException = class(EChunkedException)
  public
    constructor Create(Position: Integer);
  end;

  EInProcServerNotFoundException = class(Exception)
  public
    constructor Create(const ServerName: string);
  end;

implementation

{ TInProcHttpEngine }

const
  FromHex: array[Byte] of Integer =
    (
      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1,
      -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
      -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
    );

constructor TInProcHttpEngine.Create;
begin
  inherited Create;
end;

function TInProcHttpEngine.DoCreateRequest: THttpRequest;
begin
  Result := THttpRequest.Create;
end;

destructor TInProcHttpEngine.Destroy;
begin
  inherited;
end;

function TInProcHttpEngine.DoSend(Request: THttpRequest): THttpResponse;
var
  Context: TInProcHttpContext;
  Server: TInProcHttpServer;
begin
  Context := TInProcHttpContext.Create(Request);
  try
    Server := TInProcHttpServer.Find(Request.AsUri.Host);
    if Server = nil then
      raise EInProcServerNotFoundException.Create(Request.AsUri.Host);
    Server.Dispatcher.DispatchRequest(Context);
    Result := TInProcHttpResponse.Create(Context);
  except
    Context.Free;
    raise;
  end;
end;

{ TInProcHttpResponse }

constructor TInProcHttpResponse.Create(AContext: TInProcHttpContext);
begin
  inherited Create;
  FContext := AContext;
end;

destructor TInProcHttpResponse.Destroy;
begin
  FContext.Free;
  inherited;
end;

function TInProcHttpResponse.CreateContentStream: TStream;
begin
  Result := TInProcHttpResponseStream.Create(FContext.ResponseContent, Chunked);
end;

function TInProcHttpResponse.GetContentEncoding: string;
begin
  Result := Headers.Get('content-encoding');
end;

function TInProcHttpResponse.GetContentLength: Int64;
begin
  if not FContentLengthLoaded then
  begin
    if Chunked then
      FContentLength := -1
    else
      FContentLength := FContext.Response.ContentLength;
    FContentLengthLoaded := true;
  end;
  Result := FContentLength;
end;

function TInProcHttpResponse.GetContentType: string;
begin
  Result := Headers.Get('content-type');
end;

function TInProcHttpResponse.GetStatusCode: integer;
begin
  Result := FContext.Response.StatusCode;
end;

function TInProcHttpResponse.GetStatusReason: string;
begin
  Result := FContext.Response.StatusReason;
end;

procedure TInProcHttpResponse.UpdateHeaders(AHeaders: THttpHeaders);
var
  Header: THttpHeaderInfo;
begin
  AHeaders.Clear;
  for Header in FContext.Response.Headers.AllHeaders do
    AHeaders.SetValue(Header.Name, Header.Value);
end;

{ TInProcHttpResponseStream }

constructor TInProcHttpResponseStream.Create(AStream: TStream; AChunked: Boolean);
begin
  FStream := AStream;
  FStream.Position := 0;
  if AChunked then
    FChunkedReader := THttpChunkedReader.Create(FStream);
end;

destructor TInProcHttpResponseStream.Destroy;
begin
  FChunkedReader.Free;
  inherited;
end;

function TInProcHttpResponseStream.HttpRead(var Buffer; Count: Longint): Longint;
begin
  if FChunkedReader <> nil then
    Result := FChunkedReader.Read(Buffer, Count)
  else
    Result := FStream.Read(Buffer, Count);
end;

{ THttpChunkedReader }

constructor THttpChunkedReader.Create(AStream: TStream);
begin
  inherited Create;
  FStream := AStream;
end;

function THttpChunkedReader.Read(var Buffer; Count: Longint): Longint;
var
  TotalRead: Longint;
  BytesToRead: Longint;
  ReadBytes: Longint;
  PBuf: PByte;
begin
  if (Count <= 0) or FFinished then Exit(0);

  PBuf := @Buffer;
  TotalRead := 0;
  {$IFNDEF DELPHIBERLIN_LVL}
  ReadBytes := 0;
  {$ENDIF}
  repeat
    if FRemainingInChunk = 0 then
    begin
      FRemainingInChunk := ReadChunkSize;
      if FFinished then break;
    end;

    BytesToRead := Count - TotalRead;
    if BytesToRead > FRemainingInChunk then
      BytesToRead := FRemainingInChunk;

    ReadBytes := 0;
    if BytesToRead > 0 then
    begin
      ReadBytes := FStream.Read(PBuf^, BytesToRead);
      Inc(PBuf, ReadBytes);
      FRemainingInChunk := FRemainingInChunk - ReadBytes;
      TotalRead := TotalRead + ReadBytes;
      if FRemainingInChunk = 0 then
        ReadCRLF;
    end;
  until ReadBytes = 0;
  Result := TotalRead;
end;

function THttpChunkedReader.ReadByte: Byte;
begin
  if FStream.Read(Result, 1) <> 1 then
    raise EChunkedExpectedDataException.Create(FStream.Position);
end;

function THttpChunkedReader.ReadChunkSize: Longint;
const
  MaxChunkSize = High(Longint) div 16 div 16;
var
  B: Byte;
  Value: Integer;
begin
  Result := 0;

  B := ReadByte;
  repeat
    Value := FromHex[B];
    if Value = -1 then
      raise EChunkedInvalidSizeException.Create(FStream.Position);
    Result := Result * 16 + Value;

    // check for too big/infinite values
    if Result > MaxChunkSize then
      raise EChunkedInvalidSizeException.Create(FStream.Position);

    B := ReadByte;
  until B = 13;

  if ReadByte <> 10 then
    raise EChunkedInvalidSizeException.Create(FStream.Position);

  { Check if it's last chunk (size = 0). If it is, then read the final CRLF }
  if Result = 0 then
  begin
    ReadCRLF;
    FFinished := True;
  end;
end;

procedure THttpChunkedReader.ReadCRLF;
begin
  if ReadByte <> 13 then
    raise EChunkedExpectedCRLFException.Create(FStream.Position);
  if ReadByte <> 10 then
    raise EChunkedExpectedCRLFException.Create(FStream.Position);
end;

{ EChunkedExpectedDataException }

constructor EChunkedExpectedDataException.Create(Position: Integer);
begin
  inherited CreateFmt('Expected chunked data or size at position %d', [Position]);
end;

{ EChunkedInvalidSizeException }

constructor EChunkedInvalidSizeException.Create(Position: Integer);
begin
  inherited CreateFmt('Invalid chunk size at position %d', [Position]);
end;

{ EChunkedExpectedCRLFException }

constructor EChunkedExpectedCRLFException.Create(Position: Integer);
begin
  inherited CreateFmt('Expected CRLF at position %d', [Position]);
end;

{ EInProcServerNotFoundException }

constructor EInProcServerNotFoundException.Create(const ServerName: string);
begin
  inherited CreateFmt('In-process server "%s" not found', [ServerName]);
end;

end.
