paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 10:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Split autostore in autoconf/autosession

Browse Source 
git-svn-id: trunk@33791 -
This commit is contained in:
michael 2016-05-25 15:49:35 +00:00
parent a82196bf84
commit cf6f3b7024
1 changed files with 91 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
packages/fcl-web/src/base/fpoauth2.pp
View File

@ -162,31 +162,35 @@ Type
TOAuth2Handler = Class(TAbstractRequestSigner) TOAuth2Handler = Class(TAbstractRequestSigner)
private private
FAutoStore: Boolean; FAutoConfig: Boolean;
FAutoSession: Boolean;
FConfigLoaded: Boolean;
FSessionLoaded: Boolean;
FClaimsClass: TClaimsClass; FClaimsClass: TClaimsClass;
FConfig: TOAuth2Config; FConfig: TOAuth2Config;
FConfigLoaded: Boolean;
FIDToken: TJWTIDToken;
FOnAuthSessionChange: TOnAuthSessionChangeHandler;
FOnIDTokenChange: TOnIDTokenChangeHandler;
FSession: TOAuth2Session; FSession: TOAuth2Session;
FOnAuthConfigChange: TOnAuthConfigChangeHandler; FIDToken: TJWTIDToken;
FOnSignRequest: TOnAuthSessionChangeHandler;
FOnUserConsent: TUserConsentHandler;
FSessionLoaded: Boolean;
FWebClient: TAbstractWebClient; FWebClient: TAbstractWebClient;
FStore : TAbstracTOAuth2ConfigStore; FStore : TAbstracTOAuth2ConfigStore;
FOnAuthSessionChange: TOnAuthSessionChangeHandler;
FOnIDTokenChange: TOnIDTokenChangeHandler;
FOnSignRequest: TOnAuthConfigChangeHandler;
FOnAuthConfigChange: TOnAuthConfigChangeHandler;
FOnUserConsent: TUserConsentHandler;
Function GetAutoStore : Boolean;
Procedure SetAutoStore(AValue : Boolean);
procedure SetConfig(AValue: TOAuth2Config); procedure SetConfig(AValue: TOAuth2Config);
procedure SetSession(AValue: TOAuth2Session); procedure SetSession(AValue: TOAuth2Session);
procedure SetStore(AValue: TAbstracTOAuth2ConfigStore); procedure SetStore(AValue: TAbstracTOAuth2ConfigStore);
Protected Protected
function CheckHostedDomain(URL: String): String; virtual;
Function RefreshToken: Boolean; virtual; Function RefreshToken: Boolean; virtual;
Function CreateOauth2Config : TOAuth2Config; virtual; Function CreateOauth2Config : TOAuth2Config; virtual;
Function CreateOauth2Session : TOAuth2Session; virtual; Function CreateOauth2Session : TOAuth2Session; virtual;
Function CreateIDToken : TJWTIDToken; virtual; Function CreateIDToken : TJWTIDToken; virtual;
Procedure Notification(AComponent: TComponent; Operation: TOperation); override; Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
Procedure DoAuthConfigChange; virtual; Procedure DoAuthConfigChange; virtual;
Procedure DoAuthSessionChange; virtual; Procedure DoAuthSessionChange(Const AUser : String = ''); virtual;
Procedure DoSignRequest(ARequest: TWebClientRequest); override; Procedure DoSignRequest(ARequest: TWebClientRequest); override;
Property ConfigLoaded : Boolean Read FConfigLoaded; Property ConfigLoaded : Boolean Read FConfigLoaded;
Property SessionLoaded : Boolean Read FSessionLoaded; Property SessionLoaded : Boolean Read FSessionLoaded;
@ -199,6 +203,8 @@ Type
// Variable name for AuthScope in authentication URL. // Variable name for AuthScope in authentication URL.
// Default = scope. Descendents can override this to provide correct behaviour. // Default = scope. Descendents can override this to provide correct behaviour.
Class Function AuthScopeVariableName : String; virtual; Class Function AuthScopeVariableName : String; virtual;
// Default for hosted domain, if any
Class function DefaultHostedDomain: String; virtual;
// Check if config is authenticated. // Check if config is authenticated.
Function IsAuthenticated : Boolean; virtual; Function IsAuthenticated : Boolean; virtual;
// Generate an authentication URL // Generate an authentication URL
@ -207,11 +213,11 @@ Type
// Do whatever is necessary to mark the request as 'authenticated'. // Do whatever is necessary to mark the request as 'authenticated'.
Function Authenticate: TAuthenticateAction; virtual; Function Authenticate: TAuthenticateAction; virtual;
// Load config from store // Load config from store
procedure LoadConfig; procedure LoadConfig(Force : Boolean = false);
// Save config to store // Save config to store
procedure SaveConfig; procedure SaveConfig;
// Load Session from store.If AUser is empty, then ID Token.GetUniqueUser is used. // Load Session from store.If AUser is empty, then ID Token.GetUniqueUser is used.
procedure LoadSession(Const AUser : String = ''); procedure LoadSession(Const AUser : String = ''; AForce : Boolean = False);
// Save session in store. If AUser is empty, then ID Token.GetUniqueUser is used. Will call OnAuthSessionChange // Save session in store. If AUser is empty, then ID Token.GetUniqueUser is used. Will call OnAuthSessionChange
procedure SaveSession(Const AUser : String = ''); procedure SaveSession(Const AUser : String = '');
// Refresh ID token from Session.IDToken. Called after token is refreshed or session is loaded. // Refresh ID token from Session.IDToken. Called after token is refreshed or session is loaded.
@ -237,11 +243,15 @@ Type
// Called when the IDToken information changes // Called when the IDToken information changes
Property OnIDTokenChange : TOnIDTokenChangeHandler Read FOnIDTokenChange Write FOnIDTokenChange; Property OnIDTokenChange : TOnIDTokenChangeHandler Read FOnIDTokenChange Write FOnIDTokenChange;
// Called when a request is signed // Called when a request is signed
Property OnSignRequest : TOnAuthSessionChangeHandler Read FOnSignRequest Write FOnSignRequest; Property OnSignRequest : TOnAuthConfigChangeHandler Read FOnSignRequest Write FOnSignRequest;
// User to load/store parts of the config store. // User to load/store parts of the config store.
Property Store : TAbstracTOAuth2ConfigStore Read FStore Write SetStore; Property Store : TAbstracTOAuth2ConfigStore Read FStore Write SetStore;
// Call storing automatically when needed. // Call storing session/config automatically when needed.
Property AutoStore : Boolean Read FAutoStore Write FAutoStore; Property AutoStore : Boolean Read GetAutoStore Write SetAutoStore;
// AutoSession = True makes sure the load/save of the session as needed.
Property AutoSession : Boolean Read FAutoSession Write FAutoSession default True;
// AutoConfig = True will enable the load of config as needed.
Property AutoConfig : Boolean Read FAutoConfig Write FAutoConfig default True;
end; end;
TOAuth2HandlerClass = Class of TOAuth2Handler; TOAuth2HandlerClass = Class of TOAuth2Handler;
@ -347,13 +357,33 @@ begin
end; end;
end; end;
function TOAuth2Handler.CheckHostedDomain(URL : String): String;
Var
HD : String;
begin
HD:=Config.HostedDomain;
if (HD='') then
Result:=DefaultHostedDomain;
Result:=StringReplace(URL,'%HostedDomain%',Config.HostedDomain,[rfIgnoreCase]);
end;
Class function TOAuth2Handler.DefaultHostedDomain : String;
begin
Result:='';
end;
function TOAuth2Handler.AuthenticateURL: String; function TOAuth2Handler.AuthenticateURL: String;
begin begin
Result:=Config.AuthURL Result:=Config.AuthURL
+ '?'+ AuthScopeVariableName+'='+HTTPEncode(Config.AuthScope) + '?'+ AuthScopeVariableName+'='+HTTPEncode(Config.AuthScope)
+'&redirect_uri='+HTTPEncode(Config.RedirectUri) +'&redirect_uri='+HTTPEncode(Config.RedirectUri)
+'&client_id='+HTTPEncode(Config.ClientID) +'&client_id='+HTTPEncode(Config.ClientID)
+'&response_type=code'; // Request refresh token. +'&response_type=code'; // Request refresh token.
Result:=CheckHostedDomain(Result);
if Assigned(Session) then if Assigned(Session) then
begin begin
if (Session.LoginHint<>'') then if (Session.LoginHint<>'') then
@ -376,14 +406,15 @@ begin
FSession.Assign(AValue); FSession.Assign(AValue);
end; end;
procedure TOAuth2Handler.LoadConfig; procedure TOAuth2Handler.LoadConfig(Force : Boolean = False);
begin begin
if Assigned(Store) and not ConfigLoaded then if Assigned(Store) then
begin if Force or not ConfigLoaded then
Store.LoadConfig(Config); begin
FConfigLoaded:=True; Store.LoadConfig(Config);
end; FConfigLoaded:=True;
end;
end; end;
procedure TOAuth2Handler.SaveConfig; procedure TOAuth2Handler.SaveConfig;
@ -395,22 +426,23 @@ begin
end; end;
end; end;
procedure TOAuth2Handler.LoadSession(const AUser: String); procedure TOAuth2Handler.LoadSession(const AUser: String; AForce : Boolean = False);
Var Var
U : String; U : String;
begin begin
if Assigned(Store) then if Assigned(Store) then
begin if AForce or Not SessionLoaded then
U:=AUser; begin
If (U='') and Assigned(FIDToken) then U:=AUser;
U:=FIDToken.GetUniqueUserID; If (U='') and Assigned(FIDToken) then
Store.LoadSession(Session,AUser); U:=FIDToken.GetUniqueUserID;
FSessionLoaded:=True; Store.LoadSession(Session,AUser);
if (Session.IDToken<>'') then FSessionLoaded:=True;
RefreshIDToken; if (Session.IDToken<>'') then
end; RefreshIDToken;
end;
end; end;
procedure TOAuth2Handler.SaveSession(const AUser: String); procedure TOAuth2Handler.SaveSession(const AUser: String);
@ -428,6 +460,19 @@ begin
end; end;
end; end;
Function TOAuth2Handler.GetAutoStore : Boolean;
begin
Result:=AutoSession and AutoConfig;
end;
Procedure TOAuth2Handler.SetAutoStore(AValue : Boolean);
begin
AutoSession:=True;
AutoConfig:=True;
end;
procedure TOAuth2Handler.RefreshIDToken; procedure TOAuth2Handler.RefreshIDToken;
begin begin
FreeAndNil(FIDToken); FreeAndNil(FIDToken);
@ -449,14 +494,15 @@ Var
Resp: TWebClientResponse; Resp: TWebClientResponse;
begin begin
LoadConfig; if AutoConfig and not ConfigLoaded then
LoadConfig;
Req:=Nil; Req:=Nil;
Resp:=Nil; Resp:=Nil;
D:=Nil; D:=Nil;
try try
Req:=WebClient.CreateRequest; Req:=WebClient.CreateRequest;
Req.Headers.Values['Content-Type']:='application/x-www-form-urlencoded'; Req.Headers.Values['Content-Type']:='application/x-www-form-urlencoded';
url:=Config.TOKENURL; url:=CheckHostedDomain(Config.TOKENURL);
Body:='client_id='+HTTPEncode(Config.ClientID)+ Body:='client_id='+HTTPEncode(Config.ClientID)+
'&client_secret='+ HTTPEncode(Config.ClientSecret); '&client_secret='+ HTTPEncode(Config.ClientSecret);
if (Session.RefreshToken<>'') then if (Session.RefreshToken<>'') then
@ -475,10 +521,11 @@ begin
if Result then if Result then
begin begin
Session.LoadTokensFromJSONResponse(Resp.GetContentAsString); Session.LoadTokensFromJSONResponse(Resp.GetContentAsString);
If (Session.IDToken)<>'' then If (Session.IDToken<>'') then
begin begin
RefreshIDToken; RefreshIDToken;
DoAuthSessionChange; if AutoSession then
DoAuthSessionChange(IDToken.GetUniqueUserName);
end; end;
end end
else else
@ -518,9 +565,10 @@ end;
function TOAuth2Handler.IsAuthenticated: Boolean; function TOAuth2Handler.IsAuthenticated: Boolean;
begin begin
LoadConfig; If AutoConfig then
LoadConfig;
// See if we need to load the session // See if we need to load the session
if (Session.RefreshToken='') then if (Session.RefreshToken='') and AutoSession then
LoadSession; LoadSession;
Result:=(Session.AccessToken<>''); Result:=(Session.AccessToken<>'');
If Result then If Result then
@ -553,11 +601,12 @@ begin
SaveConfig; SaveConfig;
end; end;
procedure TOAuth2Handler.DoAuthSessionChange; procedure TOAuth2Handler.DoAuthSessionChange(Const AUser : String = '');
begin begin
If Assigned(FOnAuthSessionChange) then If Assigned(FOnAuthSessionChange) then
FOnAuthSessionChange(Self,Session); FOnAuthSessionChange(Self,Session);
SaveSession; SaveSession(AUser);
end; end;
procedure TOAuth2Handler.DoSignRequest(ARequest: TWebClientRequest); procedure TOAuth2Handler.DoSignRequest(ARequest: TWebClientRequest);
@ -580,6 +629,8 @@ begin
inherited Create(AOwner); inherited Create(AOwner);
FConfig:=CreateOauth2Config; FConfig:=CreateOauth2Config;
FSession:=CreateOauth2Session; FSession:=CreateOauth2Session;
FAutoSession:=True;
FAutoConfig:=True;
end; end;
destructor TOAuth2Handler.Destroy; destructor TOAuth2Handler.Destroy;