IW cant Handle Authentication Header

[rlebeau]

Project Project1.exe raised exception class EInHTTPUnsupportedAuthorisationScheme with message 'Unsupported authorization scheme.'.

TIdHTTPServer implements native support for only BASIC authentication.  For other authentications, you need to use the TIdHTTPServer.OnParseAuthentication event to handle them manually, eg:

Code:

procedure TMyForm.IdHTTPServer1ParseAuthentication(AContext: TIdContext;
  const AAuthType, AAuthData: String; var VUsername, VPassword: String;
  var VHandled: Boolean);
begin
  if TextIsSame(AAuthType, 'Bearer') then begin
    VUsername := '';
    VPassword := AAuthData;
    VHandled := True;
  end;
end;

And then your TIdHTTPServer.OnCommand... event handlers can use the token stored in ARequestInfo.AuthPassword as needed (if ARequestInfo.AuthExists = True).

Currently, there is no way for TIdHTTPRequestInfo to specify which auth type the client requested.  If you need that info outside of your OnParseAuthentication event handler, it will need to store that info manually in the provided TIdContext. There are two ways to handle that:

- using the TIdContext.Data property, eg:

Code:

type
  TMyContextData = class
  public
    AuthType: string;
    ...
  end;

procedure TMyForm.IdHTTPServer1ParseAuthentication(AContext: TIdContext;
  const AAuthType, AAuthData: String; var VUsername, VPassword: String;
  var VHandled: Boolean);
begin
  if AContext.Data = nil then begin
    AContext.Data := TMyContextData.Create;
  end;
  TMyContextData(AContext.Data).AuthType := AAuthType;
  if TextIsSame(AAuthType, 'Bearer') then begin
    VUsername := '';
    VPassword := AAuthData;
    VHandled := True;
  end;
end;

procedure TMyForm.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  ...
  if ARequestInfo.AuthExists and (AContext.Data <> nil) then begin
    case PosInStrArray(TMyContextData(AContext.Data).AuthType, ['Bearer', 'Basic', ...], False) of
      0: begin
        // use ARequestInfo.AuthPassword as needed...
      end;
      1: begin
        // use ARequestInfo.AuthUsername and ARequestInfo.AuthPassword as needed ...
      end;
      ...
    end;
  end;
  ...
end;

- deriving a new class from TIdServerContext, adding custom fields/properties to it, and then assigning its type to the TIdHTTPServer.ContextClass property, eg:

Code:

type
  TMyContext = class(TIdServerContext)
  public
    AuthType: string;
    ...
  end;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  // must be set before the server is activated...
  IdHTTPServer1.ContextClass := TMyContext;
end;

procedure TMyForm.IdHTTPServer1ParseAuthentication(AContext: TIdContext;
  const AAuthType, AAuthData: String; var VUsername, VPassword: String;
  var VHandled: Boolean);
begin
  TMyContext(AContext).AuthType := AAuthType;
  if TextIsSame(AAuthType, 'Bearer') then begin
    VUsername := '';
    VPassword := AAuthData;
    VHandled := True;
  end;
end;

procedure TMyForm.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  ...
  if ARequestInfo.AuthExists then begin
    case PosInStrArray(TMyContext(AContext).AuthType, ['Bearer', 'Basic', ...], False) of
      0: begin
        // use ARequestInfo.AuthPassword as needed...
      end;
      1: begin
        // use ARequestInfo.AuthUsername and ARequestInfo.AuthPassword as needed ...
      end;
      ...
    end;
  end;
  ...
end;