unit Sparkle.WebBroker.Adapter;

interface

{$IFDEF MSWINDOWS}
  {.$DEFINE USE_ISAPI}
{$ENDIF}

uses
  System.SysUtils, System.Classes,
  Web.HTTPApp,
  Web.HTTPD24, // Apache
  {$IFDEF USE_ISAPI}
  Web.Win.IsapiHTTP, // ISAPI
  Winapi.Isapi2,
  {$ENDIF}
  Sparkle.Http.Headers,
  Sparkle.WebBroker.Context;

type
  IWebBrokerAdapter = Sparkle.WebBroker.Context.IWebBrokerAdapter;

  TWebBrokerAdapter = class(TInterfacedObject, IWebBrokerAdapter)
  strict private
    FRequest: TWebRequest;
    FResponse: TWebResponse;
  public
    constructor Create(ARequest: TWebRequest; AResponse: TWebResponse);
  public
    function GetRequestMethod: string;
    function GetRequestUrl: string;
    function GetRequestContent: TBytes;
    function GetRequestHost: string;
    procedure GetRequestHeaders(Headers: THttpHeaders);

    procedure SetResponseContentLength(const Value: Int64);
    procedure SetResponseContentStream(AStream: TStream; AFreeStream: Boolean);
    procedure SetResponseStatusCode(Value: Integer);
    procedure SetResponseReasonString(Value: string);
    procedure SetResponseHeader(const Name, Value: string);
    procedure SetResponseContentType(const Value: string);
    procedure SendResponse;
    function Mode: TWebBrokerAdapterMode;
    property WebRequest: TWebRequest read FRequest;
    property WebResponse: TWebResponse read FResponse;
  end;

type
  TCompFunc = function(P: Pointer; PC: PUTF8Char; PC2: PUTF8Char): Integer; cdecl;

procedure apr_table_do(comp: TCompFunc; rec: Pointer; const t: Papr_table_t); cdecl; varargs;
{$EXTERNALSYM apr_table_do}

implementation

uses
  Web.ApacheHTTP, Web.HTTPDMethods,
  Sparkle.Utils;

procedure apr_table_do; external LibAPR name 'apr_table_do';

{ THackApacheRequest }

type
  THackApacheRequest = class(TWebRequest)
  private
    {$HINTS OFF}
    FBytesContent: TBytes;
    FContentType: string;
    {$HINTS ON}
    FRequest_rec: PHTTPDRequest;
  end;

{ TWebBrokerAdapter }

constructor TWebBrokerAdapter.Create(ARequest: TWebRequest;
  AResponse: TWebResponse);
begin
  FRequest := ARequest;
  FResponse := AResponse;
end;

function TWebBrokerAdapter.GetRequestContent: TBytes;
begin
  Result := FRequest.RawContent;
end;

function AnsiUTF8ToString(PStr: PUTF8Char): string;
var
  B: TBytes;
  Len: Integer;
begin
  Len := Length(PStr);
  SetLength(B, Len);
  if Len <> 0 then
    System.Move(PStr^, B[0], Len);
  Result := TEncoding.UTF8.GetString(B, 0, Len);
end;

function EnumApacheHeader(P: Pointer; PC: PUTF8Char; PC2: PUTF8Char): Integer; cdecl;
var
  HeaderValue: string;
  HeaderName: string;
begin
  HeaderName := AnsiUTF8ToString(PC);
  HeaderValue := AnsiUTF8ToString(PC2);
  THttpHeaders(P).SetValue(HeaderName, HeaderValue);
  Result := -1;
end;

procedure TWebBrokerAdapter.GetRequestHeaders(Headers: THttpHeaders);
var
  Req: Prequest_rec;
  RawReq: PHTTPDRequest;
begin
  if FRequest is TApacheRequest then
  begin
    // RTTI option
//    RawReq := TRttiContext.Create.GetType(TApacheRequest)
//      .GetField('FRequest_rec').GetValue(FRequest).AsType<PHTTPDRequest>;

    RawReq := THackApacheRequest(FRequest).FRequest_rec;
    Req := Prequest_rec(RawReq);
    apr_table_do(EnumApacheHeader, Headers, Req.headers_in, PChar(nil));
  end
  {$IFDEF USE_ISAPI}
  else
  if FRequest is TIsapiRequest then
  begin
    Headers.RawWideHeaders := FRequest.GetFieldByName('ALL_RAW');
  end
  {$ENDIF}
  else
    raise EUnsupportedWebBrokerAdapter.Create;
end;

function TWebBrokerAdapter.GetRequestHost: string;
begin
  Result := FRequest.Host;
end;

function TWebBrokerAdapter.GetRequestMethod: string;
begin
  Result := FRequest.Method;
end;

function TWebBrokerAdapter.GetRequestUrl: string;
begin
  case Mode of
    TWebBrokerAdapterMode.Isapi:
      begin
        Result := TSparkleUtils.CombineUrlFast(FRequest.URL, FRequest.PathInfo);
        if FRequest.Query <> '' then
          Result := Result + '?' + FRequest.Query;
      end
  else
    Result := FRequest.URL
  end;
end;

function TWebBrokerAdapter.Mode: TWebBrokerAdapterMode;
begin
  if FRequest is TApacheRequest then
    Result := TWebBrokerAdapterMode.Apache
  {$IFDEF USE_ISAPI}
  else
  if FRequest is TIsapiRequest then
    Result := TWebBrokerAdapterMode.Isapi
  {$ENDIF}
  else
    Result := TWebBrokerAdapterMode.Indy;
end;

procedure TWebBrokerAdapter.SendResponse;
begin
  FResponse.SendResponse;
end;

procedure TWebBrokerAdapter.SetResponseContentType(const Value: string);
begin
  FResponse.ContentType := Value;
end;

procedure TWebBrokerAdapter.SetResponseContentLength(const Value: Int64);
begin
  FResponse.ContentLength := Value;
end;

procedure TWebBrokerAdapter.SetResponseContentStream(AStream: TStream;
  AFreeStream: Boolean);
begin
  FResponse.ContentStream := AStream;
  FResponse.FreeContentStream := AFreeStream;
end;

procedure TWebBrokerAdapter.SetResponseHeader(const Name, Value: string);
begin
  FResponse.SetCustomHeader(Name, Value);
end;

procedure TWebBrokerAdapter.SetResponseReasonString(Value: string);
begin
  FResponse.ReasonString := Value;
end;

procedure TWebBrokerAdapter.SetResponseStatusCode(Value: Integer);
begin
  FResponse.StatusCode := Value;
end;

end.