TRestClient digest Authentication?

[Union]

Das hat mich jetzt nicht losgelassen. Ich habe etwas bei Indy abgekupfert.

Delphi-Quellcode:

unit REST.Authenticator.Digest;

interface

uses
  System.Classes,
  Data.Bind.ObjectScope,
  REST.Client;

type
  TSubDigestAuthenticationBindSource = class;

  TDigestAuthenticator = class(TCustomAuthenticator)
  protected
    FBindSource: TSubDigestAuthenticationBindSource;
    function CreateBindSource: TBaseObjectBindSource; override;
  private
    FPassword: string;
    FUsername: string;
    FNonceCount: integer;
    FQopOptions : TStringList;
    FRealm  : string;
    FNonce  : string;
    FOpaque : string;
    FQop : string;
    FMethod : string;
    FAlgorithm : string;
    FUri : string;
    procedure ReadHeader(ARequest : TCustomRESTRequest);
  protected
    procedure SetPassword(const AValue: string);
    procedure SetUsername(const AValue: string);
    procedure DoAuthenticate(ARequest: TCustomRESTRequest); override;
  public
    constructor Create(const AUsername, APassword: string); reintroduce; overload;
    constructor Create(AOwner: TComponent); overload; override;
    destructor Destroy; override;
  published
    property Username: string read FUsername write SetUsername;
    property Password: string read FPassword write SetPassword;
  end;

  TSubDigestAuthenticationBindSource = class(TRESTAuthenticatorBindSource<TDigestAuthenticator>)
  protected
    function CreateAdapterT: TRESTAuthenticatorAdapter<TDigestAuthenticator>; override;
  end;

  TDigestAuthenticatorAdapter = class(TRESTAuthenticatorAdapter<TDigestAuthenticator>)
  protected
    procedure AddFields; override;
  end;

implementation

uses
  System.Sysutils,
  System.Hash,
  Data.Bind.Components,
  REST.Consts,
  REST.Types;


{ TDigestAuthenticator }

constructor TDigestAuthenticator.Create(const AUsername, APassword: string);
begin
  Create(NIL);

  FUsername := AUsername;
  FPassword := APassword;
end;

constructor TDigestAuthenticator.Create(AOwner: TComponent);
begin
  inherited;
  FNonceCount := 1;
  FQopOptions := TStringList.Create;
end;

function TDigestAuthenticator.CreateBindSource: TBaseObjectBindSource;
begin
  FBindSource := TSubDigestAuthenticationBindSource.Create(Self);
  FBindSource.Name := 'BindSource'; { Do not localize }
  FBindSource.SetSubComponent(True);
  FBindSource.Authenticator := Self;

  result := FBindSource;
end;

destructor TDigestAuthenticator.Destroy;
begin
  FQopOptions.Free;
  inherited;
end;

procedure TDigestAuthenticator.DoAuthenticate(ARequest: TCustomRESTRequest);

function Hash(const AString : string) : string;
begin
  Result := THashMD5.GetHashString(AString);
end;

var
  LCNonce : string;
  LA1     : string;
  LA2     : string;
  LResponse : string;
  LResult : string;
begin
  if ARequest.Response.StatusCode <> 401 then Exit;
  
  ReadHeader(ARequest);
  LCNonce := Hash(DateTimeToStr(Now));

  LA1 := Username + ':' + FRealm + ':' + Password; {do not localize}
  LA2 := FMethod + ':' + FUri; {do not localize}
  LResponse := IntToHex(FNonceCount, 8) + ':' + LCNonce + ':' + FQop + ':'; {do not localize}
  LResponse := Hash( Hash(LA1) + ':' + FNonce + ':' + LResponse + Hash(LA2) ); {do not localize}

  LResult := 'Digest ' + {do not localize}
    'username="' + Username + '", ' + {do not localize}
    'realm="' + FRealm + '", ' +  {do not localize}
    'nonce="' + FNonce + '", ' + {do not localize}
    'algorithm="' + FAlgorithm + '", ' + {do not localize}
    'uri="' + FUri + '", ';

  LResult := LResult +
    'qop="' + FQop + '", ' + {do not localize}
    'nc=' + IntToHex(FNonceCount, 8) + ', ' + {do not localize}
    'cnonce="' + LCNonce + '", '; {do not localize}

  LResult := LResult + 'response="' + LResponse + '"'; {do not localize}

  if FOpaque <> '' then begin
    LResult := LResult + ', opaque="' + FOpaque + '"'; {do not localize}
  end;

  Inc(FNonceCount);
  ARequest.AddAuthParameter(HTTP_HEADERFIELD_AUTH, LResult, TRESTRequestParameterKind.pkHTTPHEADER,
  [TRESTRequestParameterOption.poDoNotEncode]);
end;

procedure TDigestAuthenticator.ReadHeader(ARequest : TCustomRESTRequest);
  function Unquote(S: String): String;
  var
    I, Len: Integer;
  begin
    Result := S;
    Len := Length(Result);
    I := 2; // skip first quote
    while I <= Len do
    begin
      if Result[I] = '"' then begin
        Break;
      end;
      if Result[I] = '\' then begin
        Inc(I);
      end;
      Inc(I);
    end;
    Result := Copy(Result, 2, I-2);
  end;
const
  AUTHVALUE  = 'WWW-Authenticate';
  DIGESTAUTH = 'Digest';
var
  S : String;
begin
  FQopOptions.Clear;
  S := ARequest.Response.Headers.Values[AUTHVALUE];
  if S.StartsWith(DIGESTAUTH) then
  begin
    S := Copy(S, Length(DIGESTAUTH) + 2);
    FQopOptions.CommaText := S;
    FRealm      := UnQuote(FQopOptions.Values['realm']);
    FNonce      := UnQuote(FQopOptions.Values['nonce']);
    FOpaque     := UnQuote(FQopOptions.Values['opaque']);
    FQop        := UnQuote(FQopOptions.Values['qop']);
    FAlgorithm  := FQopOptions.Values['algorithm'];

    case ARequest.Method of
      rmPOST: FMethod := 'POST';
      rmPUT:  FMethod := 'PUT';
      rmGET:  FMethod := 'GET';
      rmDELETE: FMethod := 'DELETE';
      rmPATCH: FMethod := 'PATCH';
    else
      raise ERESTException.Create('Unknown Method');
    end;
    FUri :=  ARequest.GetFullRequestURL();
    FUri := Copy(FUri, Pos('://', FUri) + 3);
    FUri := Copy(FUri, Pos('/', FUri));
  end;
end;

procedure TDigestAuthenticator.SetPassword(const AValue: string);
begin
 if (AValue <> FPassword) then
  begin
    FPassword := AValue;
    PropertyValueChanged;
  end;
end;

procedure TDigestAuthenticator.SetUsername(const AValue: string);
begin
  if (AValue <> FUsername) then
  begin
    FUsername := AValue;
    PropertyValueChanged;
  end;
end;

{ TDigestAuthenticatorAdapter }

procedure TDigestAuthenticatorAdapter.AddFields;
const
  sUserName = 'UserName';
  sPassword = 'Password';
var
  LGetMemberObject: IGetMemberObject;
begin
  CheckInactive;
  ClearFields;
  if Authenticator <> nil then
  begin
    LGetMemberObject := TBindSourceAdapterGetMemberObject.Create(Self);
    CreateReadWriteField<string>(sUserName, LGetMemberObject, TScopeMemberType.mtText,
      function: string
      begin
        result := Authenticator.Username;
      end,
      procedure(AValue: string)
      begin
        Authenticator.Username := AValue;
      end);
    CreateReadWriteField<string>(sPassword, LGetMemberObject, TScopeMemberType.mtText,
      function: string
      begin
        result := Authenticator.Password;
      end,
      procedure(AValue: string)
      begin
        Authenticator.Password := AValue;
      end);
  end;

end;

{ TSubDigestAuthenticationBindSource }

function TSubDigestAuthenticationBindSource.CreateAdapterT: TRESTAuthenticatorAdapter<TDigestAuthenticator>;
begin
  result := TDigestAuthenticatorAdapter.Create(Self);
end;

end.

Für den Test mit httbin:

Delphi-Quellcode:

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, REST.Client;

type
  TMainForm = class(TForm)
    RequestButton: TButton;
    procedure RequestButtonClick(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure CatchHttpProtocolError(Sender : TCustomRESTRequest);
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  REST.Types,
  REST.Authenticator.Digest;


procedure TMainForm.RequestButtonClick(Sender: TObject);
var
  Client : TRestClient;
  Request : TRestRequest;
  Auth   : TDigestAuthenticator;
begin
  Client := TRestClient.Create('http://httpbin.org');
  try
    Request := TRestRequest.Create(Client);
    Request.Resource := 'digest-auth/auth/test/user';
    Request.OnHTTPProtocolError := CatchHttpProtocolError;
    Request.Execute;
    if Request.Response.StatusCode = 401 then
    begin
      Auth := TDigestAuthenticator.Create('test', 'user');
      try
        Auth.Authenticate(Request);
        Request.Execute;
      finally
        Auth.Free;
      end;
    end;
    ShowMessage(Request.Response.Content);
  finally
    Client.Free;
  end;
end;

procedure TMainForm.CatchHttpProtocolError(Sender: TCustomRESTRequest);
begin
  if Sender.Response.StatusCode <> 401 then
  begin
    raise ERESTException.Create(Sender.Response.Content);
  end;
end;

end.