Buscando encontré un objeto que creé para probar como iba la funcionalidad nueva en Indy.
Está hecho con Delphi 2010 y habrá funciones propias o de librerías de terceros pero te valdría como plantilla para adaptarlo a D7.
Y es mejorable, para no complicarme tiro de Application.ProcessMessages. Lo suyo serían Threads y Eventos.
Te añado comentarios si hay alguna parte que no entiendes pregunta, pero antes léete en los enlaces cómo funciona el proceso de autorización y obtención de token de Oauth2 😉
Código Delphi
[-]
unit OAuth2Utils;
interface
uses
Classes,
IdHTTPServer, IdSSLOpenSSL, IdContext, IdCustomHTTPServer;
type
TOAuth2Authorizer = class(TObject)
protected
fHttpServer: TIdHTTPServer; fSslHandler: TIdServerIOHandlerSSLOpenSSL; fSslRedirect: Boolean;
fResponseHtmlOk,
fResponseHtmlError: string;
fCodeResponse: string;
fUserId,
fAccessToken,
fRefreshToken: string;
fExpires: TDateTime;
fAuthorizeEndpoint,
fAccessTokenEndpoint,
fClientId,
fClientSecret,
fScope: string;
procedure HttpServerQuerySSLPort(APort: Word; var VUseSSL: Boolean);
procedure HttpServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
private
fState: string;
function base64url(s: AnsiString): string;
function GenerarCodeVerifier: string;
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
property SslHandler: TIdServerIOHandlerSSLOpenSSL read fSslHandler;
property IsSslRedirect: Boolean read fSslRedirect write fSslRedirect;
property ResponseHtmlOk: string read fResponseHtmlOk write fResponseHtmlOk;
property ResponseHtmlError: string read fResponseHtmlError write fResponseHtmlError;
property UserId: string read fUSerId write fUserId;
property AccessToken: string read fAccessToken write fAccessToken;
property RefreshToken: string read fRefreshToken write fRefreshToken;
property Expires: TDateTime read fExpires write fExpires;
property AuthorizeEndpoint: string read fAuthorizeEndpoint write fAuthorizeEndpoint;
property AccessTokenEndpoint: string read fAccessTokenEndpoint write fAccessTokenEndpoint;
property ClientId: string read fClientId write fClientId;
property ClientSecret: string read fClientSecret write fClientSecret;
property Scope: string read fScope write fScope;
procedure SetGoogle(const ClientId: string = ''; const ClientSecret: string = '');
procedure SetMicrosoft(const ClientId: string = ''; const ClientSecret: string = '');
procedure SetOutlook(const ClientId: string = ''; const ClientSecret: string = '');
procedure GetAccessToken; procedure DoRefreshToken; end;
const
SCOPE_MS_ALL = 'https://outlook.office.com/IMAP.AccessAsUser.All https://outlook.office.com/POP.AccessAsUser.All https://outlook.office.com/SMTP.Send offline_access';
SCOPE_MS_SEND = 'https://outlook.office.com/SMTP.Send offline_access';
SCOPE_LIVE_SEND = 'wl.imap wl.emails wl.offline_access';
implementation
uses
DECFmt, DECHash, DBXJSON, JsonHelper, IdHTTP, IdGlobal,
SysUtils, StrUtils, ShellAPI, Forms, DateUtils,
Varios;
function TOAuth2Authorizer.base64url(s: AnsiString): string;
begin
Result := string(TFormat_MIME64.Encode(s));
Result := ReplaceStr(Result, '=', '');
Result := ReplaceStr(Result, '+', '-');
Result := ReplaceStr(Result, '/', '_');
end;
constructor TOAuth2Authorizer.Create(AOwner: TComponent);
begin
FUserId := '';
FAccessToken := '';
FRefreshToken := '';
FExpires := 0;
fSslRedirect := False;
fHttpServer := TIdHTTPServer.Create(nil);
with fHttpServer.Bindings.Add do
begin
IP := '127.0.0.1';
Port := 0;
IPVersion := Id_IPv4;
end;
fHttpServer.DefaultPort := 0;
fHttpServer.OnCommandGet := HttpServerCommandGet;
fHttpServer.OnQuerySSLPort := HttpServerQuerySSLPort;
fSslHandler := TIdServerIOHandlerSSLOpenSSL.Create(fHttpServer);
fHttpServer.IOHandler := fSslHandler;
fSslHandler.SSLOptions.Mode := sslmServer;
fSslHandler.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
fSslHandler.SSLOptions.VerifyDepth := 0;
fSslHandler.SSLOptions.VerifyMode := [];
end;
destructor TOAuth2Authorizer.Destroy;
begin
fHttpServer.Free;
inherited;
end;
procedure TOAuth2Authorizer.DoRefreshToken;
var
HTTP: TIdHTTP;
SSL: TIdSSLIOHandlerSocketOpenSSL;
Params: TStringList;
r, s: string;
vJson: TJSONObject;
begin
Params := TStringList.Create;
HTTP := TIdHTTP.Create(nil);
try
SSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);
SSL.DefaultPort := 443;
SSL.SSLOptions.Method := sslvTLSv1_2;
HTTP.IOHandler := SSL;
Params.Append('grant_type=refresh_token');
Params.Append('client_id=' + fClientId);
if fClientSecret <> '' then
Params.Append('client_secret=' + fClientSecret);
Params.Append('refresh_token=' + fRefreshToken);
HTTP.Request.Clear;
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
HTTP.HTTPOptions := HTTP.HTTPOptions + [hoNoProtocolErrorException, hoWantProtocolErrorContent];
r := HTTP.Post(fAccessTokenEndpoint, Params);
finally
HTTP.Free;
Params.Free;
end;
vJson := TJSONObject(TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(StripNonJson(r)),0));
if Assigned(vJson) then
try
if vJson.TryGetValue('access_token', s) then
fAccessToken := s;
if vJson.TryGetValue('refresh_token', s) then
fRefreshToken := s;
if vJson.TryGetValue('expires_in', s) then
fExpires := Now + StrToIntDef(s, 0) * OneSecond;
finally
vJson.Free;
end;
end;
function TOAuth2Authorizer.GenerarCodeVerifier: string;
var
i: Integer;
octec32: string[32];
begin
SetLength(octec32, 32);
for i := 1 to 32 do
octec32[i] := AnsiChar(Random(255));
Result := base64url(octec32);
end;
procedure TOAuth2Authorizer.GetAccessToken;
var
url,
RedirectUri,
CodeVerifier,
CodeChallenge: string;
HTTP: TIdHTTP;
HTTPSSL: TIdSSLIOHandlerSocketOpenSSL;
Params: TStringList;
r, s: string;
vJson: TJSONObject;
begin
if fAccessToken <> '' then
if fExpires > Now then
Exit;
if fRefreshToken <> '' then
begin
DoRefreshToken;
Exit;
end;
CodeVerifier := GenerarCodeVerifier;
fCodeResponse := '';
CodeChallenge := base64url(THash_SHA256.CalcBinary(RawByteString(CodeVerifier)));
FState := base64url(THash_SHA256.CalcBinary(RawByteString(IntToStr(Random(MaxInt)))));
fHttpServer.Active := True;
RedirectUri := IfThen(fSslRedirect, 'https', 'http') + '://localhost:' + IntToStr(fHttpServer.Bindings.Items[0].Port);
url := fAuthorizeEndpoint +
'?response_type=code' +
'&client_id=' + UrlEncode(fClientId) +
'&scope=' + UrlEncode(fScope) +
'&state=' + UrlEncode(FState) +
'&redirect_uri=' + UrlEncode(RedirectUri) +
'&code_challenge=' + UrlEncode(CodeChallenge) +
'&code_challenge_method=S256';
ShellExecute(0, 'open', PWideChar(url), nil, nil, 0);
while fCodeResponse = '' do
Application.ProcessMessages;
while fHttpServer.Contexts.Count > 0 do
Application.ProcessMessages;
fHttpServer.Active := False;
if not StartsText('Error', fCodeResponse) then begin
Params := TStringList.Create;
HTTP := TIdHTTP.Create(nil);
try
HTTPSSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);
HTTP.IOHandler := HTTPSSL;
HTTPSSL.DefaultPort := 0;
HTTPSSL.SSLOptions.Method := sslvTLSv1_2;
Params.Append('grant_type=authorization_code');
Params.Append('client_id=' + fClientId);
if fClientSecret <> '' then
Params.Append('client_secret=' + fClientSecret);
Params.Append('code=' + fCodeResponse);
Params.Append('redirect_uri=' + RedirectUri);
Params.Append('code_verifier=' + CodeVerifier);
HTTP.Request.Clear;
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
HTTP.HTTPOptions := HTTP.HTTPOptions + [hoNoProtocolErrorException, hoWantProtocolErrorContent];
r := HTTP.Post(fAccessTokenEndpoint, Params);
finally
HTTP.Free;
Params.Free;
end;
vJson := TJSONObject(TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(StripNonJson(r)),0));
if Assigned(vJson) then
try
if vJson.TryGetValue('user_id', s) then
FUserId := s;
if vJson.TryGetValue('access_token', s) then
FAccessToken := s;
if vJson.TryGetValue('refresh_token', s) then
FRefreshToken := s;
if vJson.TryGetValue('expires_in', s) then
FExpires := Now + StrToIntDef(s, 0) * OneSecond;
finally
vJson.Free;
end;
end;
end;
procedure TOAuth2Authorizer.HttpServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Params.Values['state'] = fState then
if ARequestInfo.Params.Values['code'] <> '' then
begin
if fResponseHtmlOk <> '' then
AResponseInfo.ContentText := fResponseHtmlOk
else
AResponseInfo.ContentText := '' +
'' +
'' +
'' +
Application.Name + '
' +
'Autorización recibida, puede cerrar la ventana.
' +
'' +
'';
fCodeResponse := ARequestInfo.Params.Values['code'];
end
else
begin
fCodeResponse := ARequestInfo.Params.Values['error'] + #13 +
ARequestInfo.Params.Values['error_description'];
if fResponseHtmlError <> '' then
AResponseInfo.ContentText := fResponseHtmlError
else
AResponseInfo.ContentText := '' +
'' +
'' +
'' +
Application.Name + '
' +
'Código de respuesta erróneo a la petición de autorización.
' +
ARequestInfo.Params.Values['code'] + '
' +
'
' +
fCodeResponse +
'' +
'';
fCodeResponse := 'Error'#13 + fCodeResponse;
end;
end;
procedure TOAuth2Authorizer.HttpServerQuerySSLPort(APort: Word;
var VUseSSL: Boolean);
begin
VUseSSL := fSslRedirect;
end;
procedure TOAuth2Authorizer.SetGoogle(const ClientId, ClientSecret: string);
begin
fAuthorizeEndpoint := 'https://accounts.google.com/o/oauth2/auth?access_type=offline';
fAccessTokenEndpoint := 'https://accounts.google.com/o/oauth2/token';
fClientId := ClientId;
fClientSecret := ClientSecret;
end;
procedure TOAuth2Authorizer.SetMicrosoft(const ClientId, ClientSecret: string);
begin
fAuthorizeEndpoint := 'https://login.microsoftonline.com/common/oauth2/v2.0/authorize';
fAccessTokenEndpoint := 'https://login.microsoftonline.com/common/oauth2/v2.0/token';
fClientId := ClientId;
fClientSecret := ClientSecret;
end;
procedure TOAuth2Authorizer.SetOutlook(const ClientId, ClientSecret: string);
begin
fAuthorizeEndpoint := 'https://login.live.com/oauth20_authorize.srf';
fAccessTokenEndpoint := 'https://login.live.com/oauth20_token.srf';
fClientId := ClientId;
fClientSecret := ClientSecret;
end;
end.
Después se usa así:
Código Delphi
[-]
oAuth2Token := TOAuth2Authorizer.Create(nil);
try
oAuth2Token.SetGoogle(GMAIL_CLIENT_ID, GMAIL_CLIENT_SECRET); oAuth2Token.Scope := SCOPE_MS_ALL;
oAuth2Token.UserId := UserId;
oAuth2Token.RefreshToken := RefreshToken;
oAuth2Token.AccessToken := AccessToken;
oAuth2Token.Expires := TokenExpires;
oAuth2Token.IsSslRedirect := False;
oAuth2Token.GetAccessToken;
UserId := oAuth2Token.UserId;
RefreshToken := oAuth2Token.RefreshToken;
AccessToken := oAuth2Token.AccessToken;
TokenExpires := oAuth2Token.Expires;
finally
oAuth2Token.Free;
end;
No es lo que buscabas, pero para casos extremos en aplicaciones viejas que uso y no controlo que no están adaptadas a OAuth uso una aplicación que es un proxy OAuth:
https://github.com/simonrob/email-oauth2-proxy