CEF4Delphi/source/uCEFOAuth2Helper.pas
salvadordf ca8bc9dff4 Added cef4delphi.chm help file
Added the PDS file to extract the HTML Help files using PasDoc
Added more XML documentation
Fixed some XML errors.
Removed the license copy from the pas units.
Updated the LICENSE.md file
2023-08-09 19:38:57 +02:00

479 lines
16 KiB
ObjectPascal

unit uCEFOAuth2Helper;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}WinApi.Windows,{$ENDIF}System.Classes, System.UITypes, System.SysUtils,
{$ELSE}
{$IFDEF MSWINDOWS}Windows,{$ENDIF} Classes, {$IFDEF FPC}dynlibs,{$ENDIF}SysUtils,
{$ENDIF}
uCEFInterfaces, uCEFTypes;
// REFERENCES :
// ============
// https://tools.ietf.org/html/rfc6749
// https://tools.ietf.org/html/rfc6750
// https://tools.ietf.org/html/rfc8252
// https://tools.ietf.org/html/rfc6819
// https://tools.ietf.org/html/rfc7636
// https://tools.ietf.org/html/draft-ietf-oauth-native-apps-12
// https://tools.ietf.org/html/draft-ietf-oauth-security-topics-13
// https://developers.google.com/identity/protocols/OAuth2
// https://developers.google.com/identity/protocols/OAuth2InstalledApp
// https://developers.google.com/identity/protocols/googlescopes
// https://developers.google.com/identity/protocols/OpenIDConnect
// https://aaronparecki.com/oauth-2-simplified/
// https://example-app.com/pkce
const
DEFAULT_REDIRECT_IPV4_HOST = '127.0.0.1';
DEFAULT_REDIRECT_IPV6_HOST = '[::1]';
DEFAULT_REDIRECT_PORT = 50000;
GOOGLE_DISCOVERY_DOCUMENT = 'https://accounts.google.com/.well-known/openid-configuration';
type
TOAuthChallengeMethod = (cmPlain, cmSHA256);
TCEFOAuth2Helper = class
protected
FRedirectHost : ustring;
FRedirectPort : integer;
FAuthEndpoint : ustring;
FTokenEndpoint : ustring;
FClientID : ustring;
FClientSecret : ustring;
FAuthCode : ustring;
FError : ustring;
FErrorDescription : ustring;
FCodeVerifier : ustring;
FCodeChallenge : ustring;
FScope : ustring;
FAccessToken : ustring;
FIDToken : ustring;
FState : ustring;
FIncState : ustring;
FRefreshToken : ustring;
FTokenExpiry : integer;
FTokenType : ustring;
FLoginHint : ustring;
FChallengeMethod : TOAuthChallengeMethod;
function GetRedirectURI : ustring; virtual;
function GetAuthCodeURI : ustring; virtual;
function GetRefreshParams : ustring; virtual;
function GetTokeExchangeParams : ustring; virtual;
function GetValidState : boolean; virtual;
procedure GenerateRandomCodeChallenge; virtual;
procedure GenerateRandomState; virtual;
function GenerateRandomString(aLength : cardinal) : ustring;
procedure ParseQueryPair(const aPair : ustring);
function ReadJSONString(const aDictionary : ICefDictionaryValue; const aKey : ustring) : ustring;
function ReadJSONInteger(const aDictionary : ICefDictionaryValue; const aKey : ustring) : integer;
function CalculateSHA256Hash(const aString : ustring) : TCefCustomByteArray;
public
constructor Create;
procedure Initialize; virtual;
function ParseTokenExchangeResponse(const aResponse : ustring) : boolean; virtual;
function ParseRefreshTokenResponse(const aResponse : ustring) : boolean; virtual;
function ParseCodeRequestResponse(const aURL : ustring) : boolean; virtual;
property AuthEndpoint : ustring read FAuthEndpoint write FAuthEndpoint;
property TokenEndpoint : ustring read FTokenEndpoint write FTokenEndpoint;
property ClientID : ustring read FClientID write FClientID;
property ClientSecret : ustring read FClientSecret write FClientSecret;
property RedirectHost : ustring read FRedirectHost write FRedirectHost;
property RedirectPort : integer read FRedirectPort write FRedirectPort;
property ChallengeMethod : TOAuthChallengeMethod read FChallengeMethod write FChallengeMethod;
property Scope : ustring read FScope write FScope;
property Error : ustring read FError;
property ErrorDescription : ustring read FErrorDescription;
property AccessToken : ustring read FAccessToken;
property IDToken : ustring read FIDToken;
property RefreshToken : ustring read FRefreshToken;
property TokenExpiry : integer read FTokenExpiry;
property TokenType : ustring read FTokenType;
property CodeVerifier : ustring read FCodeVerifier;
property CodeChallenge : ustring read FCodeChallenge;
property RedirectURI : ustring read GetRedirectURI;
property AuthCodeURI : ustring read GetAuthCodeURI;
property TokeExchangeParams : ustring read GetTokeExchangeParams;
property RefreshParams : ustring read GetRefreshParams;
property ValidState : boolean read GetValidState;
end;
implementation
uses
{$IFDEF DELPHI22_UP}System.Hash,{$ENDIF}
{$IFDEF FPC}DCPSha256,{$ENDIF}
uCEFMiscFunctions, uCEFJson;
constructor TCEFOAuth2Helper.Create;
begin
inherited Create;
Initialize;
end;
procedure TCEFOAuth2Helper.Initialize;
begin
FRedirectHost := DEFAULT_REDIRECT_IPV4_HOST;
FRedirectPort := DEFAULT_REDIRECT_PORT; // This should be a random unused port
FAuthEndpoint := 'https://accounts.google.com/o/oauth2/v2/auth'; // obtained from GOOGLE_DISCOVERY_DOCUMENT
FTokenEndpoint := 'https://oauth2.googleapis.com/token'; // obtained from GOOGLE_DISCOVERY_DOCUMENT
FClientID := '';
FClientSecret := '';
FAuthCode := '';
FError := '';
FErrorDescription := '';
FCodeVerifier := '';
FCodeChallenge := '';
FScope := 'openid';
FAccessToken := '';
FIDToken := '';
FState := '';
FIncState := '';
FRefreshToken := '';
FTokenExpiry := 0;
FTokenType := '';
FLoginHint := '';
FChallengeMethod := cmPlain;
end;
function TCEFOAuth2Helper.GetRedirectURI : ustring;
begin
Result := 'http://' + FRedirectHost + ':' + inttostr(FRedirectPort);
end;
function TCEFOAuth2Helper.GetAuthCodeURI : ustring;
begin
GenerateRandomCodeChallenge;
GenerateRandomState;
Result := FAuthEndpoint +
'?response_type=code' +
'&client_id=' + CefUriEncode(FClientID, True) +
'&redirect_uri=' + CefUriEncode(RedirectURI, True) +
'&scope=' + CefUriEncode(FScope, True) +
'&state=' + FState +
'&code_challenge=' + CefUriEncode(FCodeChallenge, True);
if (ChallengeMethod = cmPlain) then
Result := Result + '&code_challenge_method=plain'
else
Result := Result + '&code_challenge_method=S256';
if (length(FLoginHint) > 0) then
Result := Result + '&login_hint=' + CefUriEncode(FLoginHint, True);
end;
function TCEFOAuth2Helper.GetTokeExchangeParams : ustring;
begin
Result := 'grant_type=authorization_code' +
'&code=' + FAuthCode +
'&client_id=' + CefUriEncode(FClientID, True) +
'&client_secret=' + CefUriEncode(FClientSecret, True) +
'&redirect_uri=' + CefUriEncode(RedirectURI, True) +
'&code_verifier=' + CefUriEncode(FCodeVerifier, True);
end;
function TCEFOAuth2Helper.GetRefreshParams : ustring;
begin
Result := 'grant_type=refresh_token' +
'&client_id=' + CefUriEncode(FClientID, True) +
'&client_secret=' + CefUriEncode(FClientSecret, True) +
'&refresh_token=' + CefUriEncode(FRefreshToken, True);
end;
function TCEFOAuth2Helper.GetValidState : boolean;
begin
Result := (CompareStr(FState, FIncState) = 0);
end;
function TCEFOAuth2Helper.GenerateRandomString(aLength : cardinal) : ustring;
const
UnreservedCharValuesLen = 66;
UnreservedCharValues : array [0..pred(UnreservedCharValuesLen)] of
char = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M',
'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm',
'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
'-', '.', '_', '~');
var
i : cardinal;
begin
Result := '';
i := 0;
Randomize;
while (i < aLength) do
begin
Result := Result + UnreservedCharValues[Random(UnreservedCharValuesLen)];
inc(i);
end;
end;
procedure TCEFOAuth2Helper.GenerateRandomCodeChallenge;
var
TempHash : TCefCustomByteArray;
begin
// The "code_verifier" can have a minimum length of 43 characters
// and a maximum length of 128 characters.
FCodeVerifier := GenerateRandomString(64);
case ChallengeMethod of
cmPlain : FCodeChallenge := FCodeVerifier;
cmSHA256 :
try
TempHash := CalculateSHA256Hash(FCodeVerifier);
if (length(TempHash) > 0) then
begin
FCodeChallenge := CefBase64Encode(@TempHash[0], length(TempHash));
// Converts base64 to base64url.
FCodeChallenge := StringReplace(FCodeChallenge, '+', '-', [rfReplaceAll]);
FCodeChallenge := StringReplace(FCodeChallenge, '/', '_', [rfReplaceAll]);
// Strips padding.
while (length(FCodeChallenge) > 0) and (FCodeChallenge[length(FCodeChallenge)] = '=') do
FCodeChallenge := copy(FCodeChallenge, 1, pred(length(FCodeChallenge)));
end
else
FCodeChallenge := '';
finally
if (TempHash <> nil) then
begin
Finalize(TempHash);
TempHash := nil;
end;
end;
end;
end;
{$IFDEF FPC}
function TCEFOAuth2Helper.CalculateSHA256Hash(const aString : ustring) : TCefCustomByteArray;
var
TempSHA256 : TDCP_sha256;
TempString : AnsiString;
begin
Result := nil;
try
TempSHA256 := TDCP_sha256.Create(nil);
TempSHA256.Burn;
TempSHA256.Init;
TempString := AnsiString(aString);
TempSHA256.Update(TempString[1], length(TempString));
SetLength(Result, 32);
TempSHA256.Final(Result[0]);
finally
FreeAndNil(TempSHA256);
end;
end;
{$ELSE}
{$IFDEF DELPHI22_UP}
function TCEFOAuth2Helper.CalculateSHA256Hash(const aString : ustring) : TCefCustomByteArray;
var
TempBytes : TBytes;
begin
TempBytes := THashSHA2.GetHashBytes(FCodeVerifier);
SetLength(Result, length(TempBytes));
Move(TempBytes[0], Result[0], length(TempBytes));
end;
{$ELSE}
// TO-DO: Calculate SHA256 hash in older Delphi versions
function TCEFOAuth2Helper.CalculateSHA256Hash(const aString : ustring) : TCefCustomByteArray;
begin
Result := nil;
end;
{$ENDIF}
{$ENDIF}
procedure TCEFOAuth2Helper.GenerateRandomState;
begin
// The "state" should be a string of 30 or so characters constructed
// using a high-quality random-number generator.
Randomize;
FState := IntToHex(Random(high(integer)), 8) +
IntToHex(Random(high(integer)), 8) +
IntToHex(Random(high(integer)), 8) +
IntToHex(Random(high(integer)), 8);
end;
function TCEFOAuth2Helper.ReadJSONString(const aDictionary : ICefDictionaryValue; const aKey : ustring) : ustring;
var
TempValue : ICefValue;
begin
Result := '';
if (aDictionary <> nil) then
begin
TempValue := aDictionary.GetValue(aKey);
if (TempValue <> nil) and (TempValue.GetType = VTYPE_STRING) then Result := TempValue.GetString;
end;
end;
function TCEFOAuth2Helper.ReadJSONInteger(const aDictionary : ICefDictionaryValue; const aKey : ustring) : integer;
var
TempValue : ICefValue;
begin
Result := 0;
if (aDictionary <> nil) then
begin
TempValue := aDictionary.GetValue(aKey);
if (TempValue <> nil) and (TempValue.GetType = VTYPE_INT) then Result := TempValue.GetInt;
end;
end;
function TCEFOAuth2Helper.ParseTokenExchangeResponse(const aResponse : ustring) : boolean;
var
TempRoot : ICefValue;
TempDictionary : ICefDictionaryValue;
begin
Result := False;
try
if (length(aResponse) > 0) then
begin
TempRoot := TCEFJson.Parse(aResponse);
if (TempRoot <> nil) and (TempRoot.GetType = VTYPE_DICTIONARY) then
begin
TempDictionary := TempRoot.GetDictionary;
FError := ReadJSONString(TempDictionary, 'error');
if (length(FError) > 0) then
FErrorDescription := ReadJSONString(TempDictionary, 'error_description')
else
begin
FAccessToken := ReadJSONString(TempDictionary, 'access_token');
if (length(FAccessToken) > 0) then
begin
FIDToken := ReadJSONString(TempDictionary, 'id_token');
FScope := ReadJSONString(TempDictionary, 'scope');
FTokenType := ReadJSONString(TempDictionary, 'token_type');
FRefreshToken := ReadJSONString(TempDictionary, 'refresh_token');
FTokenExpiry := ReadJSONInteger(TempDictionary, 'expires_in');
Result := True;
end;
end;
end;
end;
except
on e : exception do
if CustomExceptionHandler('TCEFOAuth2Helper.ParseTokenExchangeResponse', e) then raise;
end;
end;
function TCEFOAuth2Helper.ParseRefreshTokenResponse(const aResponse : ustring) : boolean;
var
TempRoot : ICefValue;
TempDictionary : ICefDictionaryValue;
begin
Result := False;
try
if (length(aResponse) > 0) then
begin
TempRoot := TCEFJson.Parse(aResponse);
if (TempRoot <> nil) and (TempRoot.GetType = VTYPE_DICTIONARY) then
begin
TempDictionary := TempRoot.GetDictionary;
FError := ReadJSONString(TempDictionary, 'error');
if (length(FError) > 0) then
FErrorDescription := ReadJSONString(TempDictionary, 'error_description')
else
begin
FAccessToken := ReadJSONString(TempDictionary, 'access_token');
if (length(FAccessToken) > 0) then
begin
FTokenType := ReadJSONString(TempDictionary, 'token_type');
FTokenExpiry := ReadJSONInteger(TempDictionary, 'expires_in');
Result := True;
end;
end;
end;
end;
except
on e : exception do
if CustomExceptionHandler('TCEFOAuth2Helper.ParseRefreshTokenResponse', e) then raise;
end;
end;
procedure TCEFOAuth2Helper.ParseQueryPair(const aPair : ustring);
var
TempKey : ustring;
TempValue : ustring;
i : integer;
begin
i := pos('=', aPair);
if (i > 0) then
begin
TempKey := copy(aPair, 1, pred(i));
TempValue := copy(aPair, succ(i), length(aPair));
if (CompareStr(TempKey, 'code') = 0) then FAuthCode := TempValue
else if (CompareStr(TempKey, 'state') = 0) then FIncState := TempValue
else if (CompareStr(TempKey, 'error') = 0) then FError := TempValue
else if (CompareStr(TempKey, 'error_description') = 0) then FErrorDescription := TempValue;
end;
end;
function TCEFOAuth2Helper.ParseCodeRequestResponse(const aURL : ustring) : boolean;
var
TempParts : TUrlParts;
TempQuery : ustring;
i : integer;
begin
Result := False;
if (length(aURL) > 0) then
begin
CefParseUrl(aURL, TempParts);
TempQuery := TempParts.query;
if (length(TempQuery) > 0) then
begin
i := pos('&', TempQuery);
while (i > 0) do
begin
ParseQueryPair(copy(TempQuery, 1, pred(i)));
TempQuery := copy(TempQuery, succ(i), length(TempQuery));
i := pos('&', TempQuery);
end;
ParseQueryPair(TempQuery);
Result := ValidState and (length(FAuthCode) > 0);
end;
end;
end;
end.