BrookFramework/Source/BrookHTTPAuthentication.pas

(*  _                     _
 * | |__  _ __ ___   ___ | | __
 * | '_ \| '__/ _ \ / _ \| |/ /
 * | |_) | | | (_) | (_) |   <
 * |_.__/|_|  \___/ \___/|_|\_\
 *
 * Microframework which helps to develop web Pascal applications.
 *
 * Copyright (c) 2012-2021 Silvio Clecio <[email protected]>
 *
 * Brook framework is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * Brook framework is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with Brook framework; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 *)

{ Contains classes for basic HTTP authentication. }

unit BrookHTTPAuthentication;

{$I BrookDefines.inc}

interface

uses
  SysUtils,
  Marshalling,
  libsagui,
  BrookHandledClasses;

resourcestring
  { Error message @code('Invalid status code: <code>.'). }
  SBrookInvalidHTTPStatus = 'Invalid status code: %d.';

type
  { Class which holds the user authentication credentials. }
  TBrookHTTPCredentials = class(TBrookHandledPersistent)
  private
    FUserName: string;
    FPassword: string;
    FHandle: Psg_httpauth;
    function GetRealm: string;
    procedure SetRealm(const AValue: string);
  protected
    function GetHandle: Pointer; override;
  published
    { Creates an instance of @code(TBrookHTTPCredentials).
      @param(AHandle[in] Authentication handle.) }
    constructor Create(AHandle: Pointer); virtual;
    { Authentication protection space (realm). }
    property Realm: string read GetRealm write SetRealm;
    { Name of the authenticated user. }
    property UserName: string read FUserName;
    { Password of the authenticated user. }
    property Password: string read FPassword;
  end;

  { Management class to grant, deny, cancel an authentication. }
  TBrookHTTPAuthentication = class(TBrookHandledPersistent)
  private
    FCredentials: TBrookHTTPCredentials;
    FHandle: Psg_httpauth;
  protected
    class procedure CheckStatus(AStatus: Word); static;
{$IFNDEF DEBUG}inline;{$ENDIF}
    function GetHandle: Pointer; override;
    function CreateCredentials(
      AHandle: Pointer): TBrookHTTPCredentials; virtual;
  public
    { Creates an instance of @code(TBrookHTTPAuthentication).
      @param(AHandle[in] Authentication handle.) }
    constructor Create(AHandle: Pointer); virtual;
    { Destroys an instance of @code(TBrookHTTPAuthentication). }
    destructor Destroy; override;
    { Deny the authentication sending the reason to the user.
      @param(AReason[in] Denial reason.)
      @param(AContentType[in] Content type.)
      @param(AStatus[in] HTTP status code.) }
    procedure Deny(const AReason, AContentType: string;
      AStatus: Word); overload; virtual;
    { Deny the authentication sending the formatted reason to the user.
      @param(AFmt[in] Formatted string.)
      @param(AArgs[in] Arguments to compose the formatted reason.)
      @param(AContentType[in] Content type.)
      @param(AStatus[in] HTTP status code.) }
    procedure Deny(const AFmt: string; const AArgs: array of const;
      const AContentType: string; AStatus: Word); overload; virtual;
    { Deny the authentication sending the reason to the user.
      @param(AReason[in] Denial reason.)
      @param(AContentType[in] Content type.) }
    procedure Deny(const AReason, AContentType: string); overload; virtual;
    { Deny the authentication sending the formatted reason to the user.
      @param(AFmt[in] Formatted string.)
      @param(AArgs[in] Arguments to compose the formatted reason.)
      @param(AContentType[in] Content type.) }
    procedure Deny(const AFmt: string; const AArgs: array of const;
      const AContentType: string); overload; virtual;
    { Cancels the authentication loop while the user is trying to access
      the server. }
    procedure Cancel; virtual;
    { Credentials holder. }
    property Credentials: TBrookHTTPCredentials read FCredentials;
  end;

implementation

{ TBrookHTTPCredentials }

constructor TBrookHTTPCredentials.Create(AHandle: Pointer);
begin
  inherited Create;
  FHandle := AHandle;
  FUserName := TMarshal.ToString(sg_httpauth_usr(AHandle));
  FPassword := TMarshal.ToString(sg_httpauth_pwd(AHandle));
end;

function TBrookHTTPCredentials.GetHandle: Pointer;
begin
  Result := FHandle;
end;

function TBrookHTTPCredentials.GetRealm: string;
begin
  SgLib.Check;
  Result := TMarshal.ToString(sg_httpauth_realm(FHandle));
end;

procedure TBrookHTTPCredentials.SetRealm(const AValue: string);
var
  M: TMarshaller;
begin
  SgLib.Check;
  SgLib.CheckLastError(sg_httpauth_set_realm(FHandle, M.ToCString(AValue)));
end;

{ TBrookHTTPAuthentication }

constructor TBrookHTTPAuthentication.Create(AHandle: Pointer);
begin
  inherited Create;
  FHandle := AHandle;
  FCredentials := CreateCredentials(FHandle);
end;

destructor TBrookHTTPAuthentication.Destroy;
begin
  FCredentials.Free;
  inherited Destroy;
end;

function TBrookHTTPAuthentication.CreateCredentials(
  AHandle: Pointer): TBrookHTTPCredentials;
begin
  Result := TBrookHTTPCredentials.Create(AHandle);
end;

class procedure TBrookHTTPAuthentication.CheckStatus(AStatus: Word);
begin
  if (AStatus < 100) or (AStatus > 599) then
    raise EArgumentException.CreateFmt(SBrookInvalidHTTPStatus, [AStatus]);
end;

function TBrookHTTPAuthentication.GetHandle: Pointer;
begin
  Result := FHandle;
end;

procedure TBrookHTTPAuthentication.Deny(const AReason, AContentType: string;
  AStatus: Word);
var
  M: TMarshaller;
begin
  SgLib.Check;
  SgLib.CheckLastError(sg_httpauth_deny2(FHandle, M.ToCString(AReason),
    M.ToCString(AContentType), AStatus));
end;

procedure TBrookHTTPAuthentication.Deny(const AFmt: string;
  const AArgs: array of const; const AContentType: string; AStatus: Word);
begin
  Deny(Format(AFmt, AArgs), AContentType, AStatus);
end;

procedure TBrookHTTPAuthentication.Deny(const AReason,
  AContentType: string);
var
  M: TMarshaller;
begin
  SgLib.Check;
  SgLib.CheckLastError(sg_httpauth_deny(FHandle, M.ToCString(AReason),
    M.ToCString(AContentType)));
end;

procedure TBrookHTTPAuthentication.Deny(const AFmt: string;
  const AArgs: array of const; const AContentType: string);
begin
  Deny(Format(AFmt, AArgs), AContentType);
end;

procedure TBrookHTTPAuthentication.Cancel;
begin
  SgLib.Check;
  SgLib.CheckLastError(sg_httpauth_cancel(FHandle));
end;

end.