* Split autostore in autoconf/autosession

git-svn-id: trunk@33791 -

packages/fcl-web/src/base/fpoauth2.pp

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