1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-12-04 09:26:52 +02:00
CEF4Delphi/demos/Lazarus/OAuth2Tester/uOAuth2TesterFrm.pas
Salvador Díaz Fau b7a4cdd786 Update to CEF 79.1.35
- Added groups to the demos with a secondary subprocess project
- Added some conditional directives for MacOS (MACOS IS NOT SUPPORTED YET!)
- Removed some Windows dependencies in the FMXExternalPumpBrowser demo
- Added TChromium.ParentFormHandle property
2020-01-28 11:36:34 +01:00

603 lines
20 KiB
ObjectPascal

// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uOAuth2TesterFrm;
{$MODE Delphi}
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, WinApi.ShellApi,
{$ELSE}
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
{$ENDIF}
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes,
uCEFWinControl, uCEFSentinel, uCEFChromiumCore, uCEFServerComponent,
uCEFUrlRequestClientComponent, uCEFRequest, uCEFUrlRequest, uCEFOAuth2Helper;
const
URLREQUEST_SUCCESS = WM_APP + $101;
URLREQUEST_ERROR = WM_APP + $102;
AUTHCODE_ERROR = WM_APP + $103;
type
TOAuthTesterStatus = (tsIdle, tsLogin, tsRefresh, tsRequest);
TOAuth2TesterFrm = class(TForm)
CEFServerComponent1: TCEFServerComponent;
CEFUrlRequestClientComponent1: TCEFUrlRequestClientComponent;
LoginGrp: TGroupBox;
ClientIDEdt: TEdit;
ClientIDLbl: TLabel;
ClientSecretLbl: TLabel;
ClientSecretEdt: TEdit;
ScopeLbl: TLabel;
ScopeEdt: TEdit;
AccessTokenLbl: TLabel;
AccessTokenEdt: TEdit;
RefreshTokenLbl: TLabel;
RefreshTokenEdt: TEdit;
LoginBtn: TButton;
RefreshBtn: TButton;
LogGrp: TGroupBox;
LogMem: TMemo;
ApiPnl: TPanel;
ApiGrp: TGroupBox;
EndpointLbl: TLabel;
EndpointEdt: TEdit;
RequestBtn: TButton;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure LoginBtnClick(Sender: TObject);
procedure RefreshBtnClick(Sender: TObject);
procedure RequestBtnClick(Sender: TObject);
procedure CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
procedure CEFUrlRequestClientComponent1DownloadData(Sender: TObject; const request: ICefUrlRequest; data: Pointer; dataLength: NativeUInt);
procedure CEFUrlRequestClientComponent1DownloadProgress( Sender: TObject; const request: ICefUrlRequest; current, total: Int64);
procedure CEFUrlRequestClientComponent1RequestComplete(Sender: TObject; const request: ICefUrlRequest);
procedure CEFServerComponent1HttpRequest(Sender: TObject; const server: ICefServer; connection_id: Integer; const client_address: ustring; const request: ICefRequest);
procedure CEFServerComponent1ServerDestroyed(Sender: TObject; const server: ICefServer);
protected
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
FMemStream : TMemoryStream;
FBusy : boolean;
FOAuthHelper : TCEFOAuth2Helper;
FStatus : TOAuthTesterStatus;
procedure CreateLoginRequest;
procedure CreateTokenRefreshRequest;
procedure CreateAPIRequest;
procedure AppendAuthorizationHeader(const aRequest : ICefRequest);
procedure URLRequestSuccessMsg(var aMessage : TMessage); message URLREQUEST_SUCCESS;
procedure URLRequestErrorMsg(var aMessage : TMessage); message URLREQUEST_ERROR;
procedure AuthCodeErrorMsg(var aMessage : TMessage); message AUTHCODE_ERROR;
end;
var
OAuth2TesterFrm: TOAuth2TesterFrm;
implementation
{$R *.lfm}
// This demo shows how to authenticate users using OAuth 2.0 and how
// to make requests to REST APIs that requiere authenticated users.
// Before you begin, please read the code comments in the URLRequest and SimpleServer
// demos because this demo uses the TCEFUrlRequestClientComponent and TCEFServerComponent
// components too.
// This demo was tested with the Google API only. If you need to access other REST APIs you
// may need to override some TCEFOAuth2Helper functions to send the right URL parameters.
// This is an alternative to the "REST Client Library" found in the
// latest Delphi but this time using CEF classes and functions like
// TCEFUrlRequestClientComponent, TCEFServerComponent, etc.
// As you can see in the REFERENCES, you need to follow a few steps
// to implement OAuth 2.0 in windows applications.
// STEP 1 :
// ========
// Obtain OAuth 2.0 client credentials from the API server.
// In this case, open the Google API Console at https://console.developers.google.com/
// and go to the "Credentials" page at https://console.developers.google.com/apis/credentials
// Then click "Create credentials -> OAuth client ID" and select "other" to create
// credentials for "native" applications.
// When it finishes you will see a "Client ID" and a "Client Secret" that you will need
// to run this demo.
// STEP 2 :
// ========
// Run this demo and fill the "Client ID" and "Client Secret" edit boxes with the credentials
// you got from Google.
// STEP 3 :
// ========
// Click on the "User login" button to launch the system browser and login to google with
// another user account. The URL in that login page was created by TCEFOAuth2Helper and it
// includes the credentials and other safety parameters.
// Once the user authenticated and he/she has granted permissions the browser will be
// redirected to a local URL served by TCEFServerComponent but Google has added some
// parameters to the redirected URL that will be used in later steps.
// STEP 4 :
// ========
// This demo uses TCEFOAuth2Helper to parse the parameters in the redirected URL which includes an
// "authentication code" and then it uses TCEFUrlRequestClientComponent to send a POST request
// to exchange that "authentication code" for an "access token".
// STEP 5 :
// ========
// TCEFUrlRequestClientComponent receives the "access token" and a "refresh token" that we'll use to
// request whatever we need to the REST API.
// STEP 6 :
// ========
// Click on the "Request" button to request some user information to the REST API using a
// GET request with TCEFUrlRequestClientComponent. This request includes the "access token" in the
// "Authorization" HTTP header.
// STEP 7 :
// ========
// The "access token" is only valid for some time and we'll need to click the "Request new token"
// button to receive a new token when it expires. This function uses TCEFOAuth2Helper and
// TCEFUrlRequestClientComponent to generate the parameters in a POST request needed to
// refresh the token.
// Read the TCEFOAuth2Helper.TokenExpiry property to know the amount of seconds that the
// "access token" will be valid.
// Destruction steps
// =================
// 1- Set CanClose to FALSE in the TForm.OnCloseQuery event, set FClosing to TRUE and call TCEFServerComponent.shutdown.
// 2- If there are pending URLRequests and the TCEFUrlRequestClientComponent.OnDownloadProgress
// event is executed then call request.Cancel, which triggers the TCEFUrlRequestClientComponent.OnRequestComplete event.
// 3- In the TCEFUrlRequestClientComponent.OnRequestComplete event set FCanClose := True and send WM_CLOSE to the form.
// 4- If the TCEFServerComponent was initialized it will trigger TCEFServerComponent.OnServerDestroyed that sets
// FCanClose := True and sends WM_CLOSE to the form.
// 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
uses
uCEFApplication, uCEFMiscFunctions, uCEFPostData, uCEFPostDataElement, uCEFStringMultimap;
procedure TOAuth2TesterFrm.CEFServerComponent1HttpRequest(Sender: TObject;
const server: ICefServer; connection_id: Integer;
const client_address: ustring; const request: ICefRequest);
var
TempData : string;
begin
TempData := '<html><head><title>User authentication successfull</title></head>' +
'<body><p>User authentication successfull.</p><p>You can close this window now.</p></body></html>';
CEFServerComponent1.SendHttp200response(connection_id, 'text/html', @TempData[1], length(TempData) * SizeOf(char));
if (request <> nil) then
begin
if FOAuthHelper.ParseCodeRequestResponse(request.url) then
CEFUrlRequestClientComponent1.AddURLRequest
else
PostMessage(Handle, AUTHCODE_ERROR, 0, 0);
end;
end;
procedure TOAuth2TesterFrm.CEFServerComponent1ServerDestroyed(Sender: TObject; const server: ICefServer);
begin
if FClosing then
begin
FCanClose := True;
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
end;
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1DownloadData(
Sender: TObject; const request: ICefUrlRequest; data: Pointer;
dataLength: NativeUInt);
begin
try
if FClosing then
request.Cancel
else
if (data <> nil) and (dataLength > 0) then
FMemStream.WriteBuffer(data^, dataLength);
except
on e : exception do
if CustomExceptionHandler('TOAuth2BrowserFrm.CEFUrlRequestClientComponent1DownloadData', e) then raise;
end;
end;
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1DownloadProgress(
Sender: TObject; const request: ICefUrlRequest; current, total: Int64);
begin
if FClosing then request.Cancel;
end;
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1RequestComplete(
Sender: TObject; const request: ICefUrlRequest);
begin
FBusy := False;
if FClosing then
begin
FCanClose := True;
PostMessage(Handle, WM_CLOSE, 0, 0);
end
else
if (request <> nil) then
begin
if (request.response <> nil) and
(request.RequestStatus = UR_SUCCESS) and
(pos('application/json', request.response.MimeType) > 0) then
PostMessage(Handle, URLREQUEST_SUCCESS, 0, 0)
else
PostMessage(Handle, URLREQUEST_ERROR, 0, request.RequestError);
end
else
PostMessage(Handle, URLREQUEST_ERROR, 0, 0);
end;
procedure TOAuth2TesterFrm.CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
begin
case FStatus of
tsLogin : CreateLoginRequest;
tsRefresh : CreateTokenRefreshRequest;
tsRequest : CreateAPIRequest;
end;
end;
procedure TOAuth2TesterFrm.CreateLoginRequest;
var
TempRequest : ICefRequest;
TempPostData : ICefPostData;
TempElement : ICefPostDataElement;
TempElementData : AnsiString;
begin
try
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := FOAuthHelper.TokenEndpoint;
TempRequest.Method := 'POST';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
TempElementData := AnsiString(FOAuthHelper.TokeExchangeParams);
TempElement := TCefPostDataElementRef.New;
TempElement.SetToBytes(length(TempElementData), @TempElementData[1]);
TempPostData := TCefPostDataRef.New;
TempPostData.AddElement(TempElement);
TempRequest.PostData := TempPostData;
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
finally
TempElement := nil;
TempPostData := nil;
TempRequest := nil;
end;
end;
procedure TOAuth2TesterFrm.CreateTokenRefreshRequest;
var
TempRequest : ICefRequest;
TempPostData : ICefPostData;
TempElement : ICefPostDataElement;
TempElementData : AnsiString;
begin
try
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := FOAuthHelper.TokenEndpoint;
TempRequest.Method := 'POST';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
TempElementData := AnsiString(FOAuthHelper.RefreshParams);
TempElement := TCefPostDataElementRef.New;
TempElement.SetToBytes(length(TempElementData), @TempElementData[1]);
TempPostData := TCefPostDataRef.New;
TempPostData.AddElement(TempElement);
TempRequest.PostData := TempPostData;
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
finally
TempElement := nil;
TempPostData := nil;
TempRequest := nil;
end;
end;
procedure TOAuth2TesterFrm.CreateAPIRequest;
var
TempRequest : ICefRequest;
begin
try
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := EndpointEdt.Text;
TempRequest.Method := 'GET';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
AppendAuthorizationHeader(TempRequest);
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
finally
TempRequest := nil;
end;
end;
procedure TOAuth2TesterFrm.AppendAuthorizationHeader(const aRequest : ICefRequest);
var
TempOldMap, TempNewMap : ICefStringMultimap;
i : NativeUInt;
begin
try
TempNewMap := TCefStringMultimapOwn.Create;
TempOldMap := TCefStringMultimapOwn.Create;
aRequest.GetHeaderMap(TempOldMap);
i := 0;
while (i < TempOldMap.Size) do
begin
TempNewMap.Append(TempOldMap.Key[i], TempOldMap.Value[i]);
inc(i);
end;
TempNewMap.Append('Authorization', FOAuthHelper.TokenType + ' ' + FOAuthHelper.AccessToken);
aRequest.SetHeaderMap(TempNewMap);
finally
TempNewMap := nil;
TempOldMap := nil;
end;
end;
procedure TOAuth2TesterFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose and not(FBusy) and not(CEFServerComponent1.Initialized);
if not(FClosing) then
begin
FClosing := True;
Visible := False;
if CEFServerComponent1.Initialized then CEFServerComponent1.Shutdown;
end;
end;
procedure TOAuth2TesterFrm.FormCreate(Sender: TObject);
begin
FMemStream := TMemoryStream.Create;
FCanClose := False;
FClosing := False;
FBusy := False;
FStatus := tsIdle;
FOAuthHelper := TCEFOAuth2Helper.Create;
FOAuthHelper.ChallengeMethod := cmSHA256;
CEFServerComponent1.CreateServer(FOAuthHelper.RedirectHost, FOAuthHelper.RedirectPort, 10);
end;
procedure TOAuth2TesterFrm.FormDestroy(Sender: TObject);
begin
if (FMemStream <> nil) then FreeAndNil(FMemStream);
if (FOAuthHelper <> nil) then FreeAndNil(FOAuthHelper);
end;
procedure TOAuth2TesterFrm.LoginBtnClick(Sender: TObject);
var
TempAuthURI : string;
begin
if (FStatus <> tsIdle) or
(length(ClientIDEdt.Text) = 0) or
(length(ClientSecretEdt.Text) = 0) or
(length(ScopeEdt.Text) = 0) then
exit;
FStatus := tsLogin;
screen.cursor := crAppStart;
FOAuthHelper.ClientID := ClientIDEdt.Text;
FOAuthHelper.ClientSecret := ClientSecretEdt.Text;
FOAuthHelper.Scope := ScopeEdt.Text;
TempAuthURI := FOAuthHelper.AuthCodeURI;
LogMem.Lines.Add('-----------------------------------------------------------------');
LogMem.Lines.Add('Opening authorization request in the system browser : ' + TempAuthURI);
OpenURL(TempAuthURI);
end;
procedure TOAuth2TesterFrm.RefreshBtnClick(Sender: TObject);
begin
if (FStatus <> tsIdle) or
(length(ClientIDEdt.Text) = 0) or
(length(ClientSecretEdt.Text) = 0) or
(length(ScopeEdt.Text) = 0) or
(length(RefreshTokenEdt.Text) = 0) then
exit;
FStatus := tsRefresh;
screen.cursor := crAppStart;
LogMem.Lines.Add('-----------------------------------------------------------------');
LogMem.Lines.Add('Requesting a new token.');
CEFUrlRequestClientComponent1.AddURLRequest;
end;
procedure TOAuth2TesterFrm.RequestBtnClick(Sender: TObject);
begin
if (FStatus <> tsIdle) or
(length(ClientIDEdt.Text) = 0) or
(length(ClientSecretEdt.Text) = 0) or
(length(ScopeEdt.Text) = 0) or
(length(EndpointEdt.Text) = 0) then
exit;
FStatus := tsRequest;
screen.cursor := crAppStart;
LogMem.Lines.Add('-----------------------------------------------------------------');
LogMem.Lines.Add('Requesting information to the API endpoint.');
CEFUrlRequestClientComponent1.AddURLRequest;
end;
procedure TOAuth2TesterFrm.URLRequestSuccessMsg(var aMessage : TMessage);
var
TempRawResponse : AnsiString;
TempResponse : ustring;
begin
if (FMemStream = nil) or (FMemStream.Size = 0) then exit;
try
FMemStream.position := 0;
SetLength(TempRawResponse, FMemStream.Size);
if (FMemStream.Read(TempRawResponse[1], FMemStream.Size) > 0) then
begin
TempResponse := UTF8Decode(TempRawResponse);
case FStatus of
tsLogin :
begin
LogMem.Lines.Add('Token exchange response : ' + TempResponse);
if FOAuthHelper.ParseTokenExchangeResponse(TempResponse) then
begin
AccessTokenEdt.Text := FOAuthHelper.AccessToken;
RefreshTokenEdt.Text := FOAuthHelper.RefreshToken;
end
else
begin
AccessTokenEdt.Text := '';
RefreshTokenEdt.Text := '';
showmessage('Login error : ' + FOAuthHelper.Error + #13 + #10 + FOAuthHelper.ErrorDescription);
end;
end;
tsRefresh :
begin
LogMem.Lines.Add('Token refresh response : ' + TempResponse);
if FOAuthHelper.ParseRefreshTokenResponse(TempResponse) then
AccessTokenEdt.Text := FOAuthHelper.AccessToken
else
showmessage('Token refresh error : ' + FOAuthHelper.Error + #13 + #10 + FOAuthHelper.ErrorDescription);
end;
tsRequest :
LogMem.Lines.Add('API request response : ' + TempResponse);
end;
end;
finally
FMemStream.Clear;
FStatus := tsIdle;
screen.cursor := crDefault;
end;
end;
procedure TOAuth2TesterFrm.URLRequestErrorMsg(var aMessage : TMessage);
begin
case FStatus of
tsLogin : showmessage('Login error code : ' + inttostr(aMessage.lParam));
tsRefresh : showmessage('Token refresh error code : ' + inttostr(aMessage.lParam));
tsRequest : showmessage('API request error code : ' + inttostr(aMessage.lParam));
end;
FMemStream.Clear;
FStatus := tsIdle;
screen.cursor := crDefault;
end;
procedure TOAuth2TesterFrm.AuthCodeErrorMsg(var aMessage : TMessage);
var
TempMessage : string;
begin
TempMessage := 'Authentication error' + #13 + #10;
if not(FOAuthHelper.ValidState) then
TempMessage := TempMessage + #13 + #10 + 'Received request with invalid state';
if (length(FOAuthHelper.Error) > 0) then
TempMessage := TempMessage + #13 + #10 + FOAuthHelper.Error + #13 + #10 + FOAuthHelper.ErrorDescription;
showmessage(TempMessage);
end;
end.