Coping with Stupid users

[david-navigator]

I've just spent a day trying to debug why this oAuth2 stuff was failing for a particular customer. Seems that the customer was telling my application that they were using the email address someone@mydomain.com, but when the Microsoft authentication browser window popped up, they were actually authenticating against someone@mydomain.net. (it seems that their Microsoft account supports both domains)

I can't find any reference as to how to get oAuth2 to work with different email addresses like this, and to be frank I doubt it does, so I've added some code to my implementation of IdSASL.Outh.Base.

I've copied it below in case it's of use to anyone else.

unit IdSASL.OAuth.Base;

interface

uses
    Classes
  , SysUtils
  , IdSASL
  , System.NetEncoding
  , System.JSON
    ;

type
  TIdSASLOAuthBase = class(TIdSASL)
  private
    procedure SetToken(const Value: string);
    procedure SetUser(const Value: string);
    procedure ValidateCredentials;
  protected
    FToken: string;
    FUser: string;
  public
    property User: string read FUser write SetUser;
    property Token: string read FToken write SetToken;
  end;

implementation

resourcestring
  StrYourEmailProivder = 'Can not Authenticate with mail server: ' + #10+#13+#10+#13 +
  'Your email provider expects you to use the email address %s, but you are using %s';

procedure TIdSASLOAuthBase.SetToken(const Value: string);
begin
  FToken := Value;
  if not FUser.isempty then ValidateCredentials;

end;

procedure TIdSASLOAuthBase.SetUser(const Value: string);
begin
  FUser := Value;
  if not FToken.isempty then ValidateCredentials;
end;

function Base64URLDecode(const Base64URL: string): string;
var
  Base64Str: string;
begin
  // Replace Base64URL characters with Base64 characters
  Base64Str := StringReplace(Base64URL, '-', '+', [rfReplaceAll]);
  Base64Str := StringReplace(Base64Str, '_', '/', [rfReplaceAll]);

  // Add padding if necessary
  case Length(Base64Str) mod 4 of
    2: Base64Str := Base64Str + '==';
    3: Base64Str := Base64Str + '=';
  end;

  // Decode from Base64
  Result := TNetEncoding.Base64.Decode(Base64Str);
end;

function DecodeJWT(const Token: string): TJSONObject;
var
  Parts: TArray<string>;
  Payload: string;
  JSONPayload: TJSONObject;
begin
  Result := nil;

  // Split the JWT into its three parts
  Parts := Token.Split(['.']);

  if Length(Parts) <> 3 then
    raise Exception.Create('Invalid JWT token');

  // Decode the payload
  Payload := Base64URLDecode(Parts[1]);

  // Parse the JSON payload
  JSONPayload := TJSONObject.ParseJSONValue(Payload) as TJSONObject;

  if Assigned(JSONPayload) then
    Result := JSONPayload
  else
    raise Exception.Create('Invalid JSON payload in JWT token');
end;

function ExtractUPNFromJWT(const Token: string): string;
var
  Claims: TJSONObject;
  UPNValue: string;
begin
  Claims := DecodeJWT(Token);
  try
    if Assigned(Claims) then
    begin
      // Check if the "upn" claim exists and extract its value
      if Claims.TryGetValue<string>('upn', UPNValue) then
        Result := UPNValue
      else
        Result := 'UPN claim not found in the JWT token.';
    end;
  finally
    Claims.Free;
  end;
end;

procedure TIdSASLOAuthBase.ValidateCredentials;
Var
lEmail : string;
begin
  lEmail := ExtractUPNFromJWT(token);
  if CompareText(FUser,lEmail) <> 0 then
  raise exception.Create(Format(StrYourEmailProivder,[lEmail, FUser]));
end;

end.

[geoffsmith82]

I can't test this problem... but did you look at the documentation here

https://learn.microsoft.com/en-us/entra/identity-platform/v2-oauth2-auth-code-flow

Specifically one of these

prompt=select_account

login_hint

domain_hint

[david-navigator]

Ah! Thanks I wasn't aware of these. I can see how they could be useful, especially if users have SSO enabled and so don't even get the choice of which account to use and I'll certainly look at implementing it. However in this specific scenario the customer was "clever" enough that they would have still used the wrong domain :)

[geoffsmith82]

Also... in recent versions of delphi instead of your Base64URLDecode function you could replace it with TNetEncoding.Base64Url.Decode(Base64Str);. I made a feature request for them to add it probably 3-5 years ago and they added it.