new Quick.HttpServer

Author: exilon

Quick.HttpServer.Request.pas

@@ -0,0 +1,311 @@
+{ ***************************************************************************
+
+  Copyright (c) 2016-2019 Kike Pérez
+
+  Unit        : Quick.HttpServer.Request
+  Description : Http Server Request
+  Author      : Kike Pérez
+  Version     : 1.8
+  Created     : 30/08/2019
+  Modified    : 31/08/2019
+
+  This file is part of QuickLib: https://github.com/exilon/QuickLib
+
+ ***************************************************************************
+
+  Licensed under the Apache License, Version 2.0 (the "License");
+  you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at
+
+  http://www.apache.org/licenses/LICENSE-2.0
+
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.
+
+ *************************************************************************** }
+
+unit Quick.HttpServer.Request;
+
+{$i QuickLib.inc}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  Quick.Commons,
+  Quick.Arrays,
+  Quick.Value,
+  Quick.HttpServer.Types;
+
+type
+  EHttpRequestError = class(Exception);
+
+type
+  IHttpRequest = interface
+  ['{D6B236A5-9D04-4380-8A89-5BD4CC60A1A6}']
+    function GetPathSegment(aIndex : Integer) : string;
+    function GetQuery(const aName : string) : TFlexValue;
+    function GetURL: string;
+    function GetMethod: TMethodVerb;
+    function GetCacheControl: string;
+    function GetClientIP: string;
+    function GetContent: TStream;
+    function GetHeaders: TPairList;
+    function GetHost: string;
+    function GetPort: Integer;
+    function GetReferer: string;
+    function GetUnparsedParams: string;
+    function GetUserAgent: string;
+    property URL : string read GetURL;
+    property Method : TMethodVerb read GetMethod;
+    property Host : string read GetHost;
+    property Port : Integer read GetPort;
+    property Referer : string read GetReferer;
+    property UserAgent : string read GetUserAgent;
+    property CacheControl : string read GetCacheControl;
+    property PathSegment[aIndex : Integer] : string read GetPathSegment;
+    property UnparsedParams : string read GetUnparsedParams;
+    property Query[const aName : string] : TFlexValue read GetQuery;
+    property ClientIP : string read GetClientIP;
+    property Headers : TPairList read GetHeaders;
+    property Content : TStream read GetContent;
+    function ContentAsString : string;
+    function GetMethodAsString: string;
+  end;
+
+  THttpRequest = class(TInterfacedObject,IHttpRequest)
+  private
+    fURL : string;
+    fMethod : TMethodVerb;
+    fHost : string;
+    fPort : Integer;
+    fReferer : string;
+    fUserAgent : string;
+    fCacheControl : string;
+    fUnparsedParams : string;
+    fParsedQuery : TFlexPairArray;
+    fClientIP : string;
+    fHeaders : TPairList;
+    fContent : TStream;
+    fContentType : string;
+    fContentEncoding : string;
+    fContentLength : Int64;
+    function GetPathSegment(aIndex : Integer) : string;
+    function GetQuery(const aName : string) : TFlexValue;
+    procedure ParseQuery;
+    function GetURL: string;
+    function GetMethod: TMethodVerb;
+    function GetCacheControl: string;
+    function GetClientIP: string;
+    function GetContent: TStream;
+    function GetHeaders: TPairList;
+    function GetHost: string;
+    function GetPort: Integer;
+    function GetReferer: string;
+    function GetUnparsedParams: string;
+    function GetUserAgent: string;
+    procedure SetURL(const Value: string);
+    function GetContentEncoding: string;
+    function GetContentLength: Int64;
+    function GetContentType: string;
+    procedure SetContentEncoding(const Value: string);
+    procedure SetContentLength(const Value: Int64);
+    procedure SetContentType(const Value: string);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    property URL : string read GetURL write SetURL;
+    property Method : TMethodVerb read GetMethod write fMethod;
+    property Host : string read GetHost write fHost;
+    property Port : Integer read GetPort write fPort;
+    property Referer : string read GetReferer write fReferer;
+    property UserAgent : string read GetUserAgent write fUserAgent;
+    property CacheControl : string read GetCacheControl write fCacheControl;
+    property PathSegment[aIndex : Integer] : string read GetPathSegment;
+    property UnparsedParams : string read GetUnparsedParams write fUnparsedParams;
+    property Query[const aName : string] : TFlexValue read GetQuery;
+    property ClientIP : string read GetClientIP write fClientIP;
+    property Headers : TPairList read GetHeaders write fHeaders;
+    property Content : TStream read GetContent write fContent;
+    property ContentType : string read GetContentType write SetContentType;
+    property ContentEncoding : string read GetContentEncoding write SetContentEncoding;
+    property ContentLength : Int64 read GetContentLength write SetContentLength;
+    procedure SetMethodFromString(const aVerbMethod : string);
+    function GetMethodAsString: string;
+    function ContentAsString : string;
+  end;
+
+implementation
+
+function THttpRequest.ContentAsString: string;
+begin
+  if fContent <> nil then Result := StreamToString2(fContent,TEncoding.UTF8);
+end;
+
+constructor THttpRequest.Create;
+begin
+  fHeaders := TPairList.Create;
+end;
+
+destructor THttpRequest.Destroy;
+begin
+  fHeaders.Free;
+  inherited;
+end;
+
+function THttpRequest.GetCacheControl: string;
+begin
+  Result := fCacheControl;
+end;
+
+function THttpRequest.GetClientIP: string;
+begin
+  Result := fClientIP;
+end;
+
+function THttpRequest.GetContent: TStream;
+begin
+  Result := fContent;
+end;
+
+function THttpRequest.GetContentEncoding: string;
+begin
+  Result := fContentEncoding;
+end;
+
+function THttpRequest.GetContentLength: Int64;
+begin
+  Result := fContentLength;
+end;
+
+function THttpRequest.GetContentType: string;
+begin
+  Result := fContentType;
+end;
+
+function THttpRequest.GetHeaders: TPairList;
+begin
+  Result := fHeaders;
+end;
+
+function THttpRequest.GetHost: string;
+begin
+  Result := fHost;
+end;
+
+function THttpRequest.GetMethod: TMethodVerb;
+begin
+  Result := fMethod;
+end;
+
+function THttpRequest.GetMethodAsString: string;
+begin
+  Result := MethodVerbStr[Integer(fMethod)];
+end;
+
+function THttpRequest.GetPathSegment(aIndex: Integer): string;
+var
+  upath : string;
+  segment : TArray<string>;
+begin
+  try
+    if fURL.StartsWith('/') then upath := furl.Substring(1)
+      else upath := fURL;
+    segment := upath.Split(['/']);
+    if (High(segment) < aIndex) or (aIndex < 0) then raise EHttpRequestError.CreateFmt('param out of bounds (%d)',[aIndex]);
+    Result := segment[aIndex];
+  except
+    on E : Exception do raise EHttpRequestError.CreateFmt('Error getting url path param : %s',[e.message]);
+  end;
+end;
+
+function THttpRequest.GetPort: Integer;
+begin
+  Result := fPort;
+end;
+
+function THttpRequest.GetQuery(const aName: string): TFlexValue;
+begin
+  if fParsedQuery.Count = 0 then ParseQuery;
+  Result := fParsedQuery.GetValue(aName);
+end;
+
+function THttpRequest.GetReferer: string;
+begin
+  Result := fReferer;
+end;
+
+function THttpRequest.GetUnparsedParams: string;
+begin
+  Result := fUnparsedParams;
+end;
+
+function THttpRequest.GetURL: string;
+begin
+  Result := fURL;
+end;
+
+function THttpRequest.GetUserAgent: string;
+begin
+  Result := fUserAgent;
+end;
+
+procedure THttpRequest.ParseQuery;
+var
+  param : string;
+  pair : TFlexPair;
+  posi : Integer;
+begin
+  for param in fUnparsedParams.Split(['&']) do
+  begin
+    posi := Pos('=',param);
+    pair.Name := Copy(param,1,posi - 1);
+    pair.Value := param.Substring(posi);
+    fParsedQuery.Add(pair);
+  end;
+end;
+
+procedure THttpRequest.SetContentEncoding(const Value: string);
+begin
+  fContentEncoding := Value;
+end;
+
+procedure THttpRequest.SetContentLength(const Value: Int64);
+begin
+  fContentLength := Value;
+end;
+
+procedure THttpRequest.SetContentType(const Value: string);
+begin
+  fContentType := Value;
+end;
+
+procedure THttpRequest.SetMethodFromString(const aVerbMethod: string);
+var
+  i : Integer;
+begin
+  fMethod := TMethodVerb.mUNKNOWN;
+  for i := 0 to Ord(High(TMethodVerb)) do
+  begin
+    if CompareText(aVerbMethod,MethodVerbStr[i]) = 0 then
+    begin
+      fMethod := TMethodVerb(i);
+      Exit;
+    end;
+  end;
+end;
+
+procedure THttpRequest.SetURL(const Value: string);
+begin
+  //remove first slash
+  if Value.StartsWith('/') then fURL := Value.Substring(1)
+    else fURL := Value;
+  //remove last slash
+  if fURL.EndsWith('/') then fURL := Copy(fURL,0,fURL.Length -1);
+end;
+
+end.