Tema: OAuth indy10
Ver Mensaje Individual
  #5  
Antiguo 15-07-2025
Garada Garada is offline
Miembro
 
Registrado: jul 2004
Posts: 90
Reputación: 22
Garada Va por buen camino
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; // Servidor interno dónde recibir las respuestas de la autorización
    fSslHandler: TIdServerIOHandlerSSLOpenSSL; // No olvides poner las librería OpenSSL dónde las encuentre el ejecutable
    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;

    // Valores de los token que hayas guardado, vacíos en el primer uso
    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;

    // Las direcciones y variables para obtener las autorizaciones y tokens
    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;

    // Estas llamadas facilitan rellenar los campos anteriores según el proveedor  
    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; // con esto obtienes el token
    procedure DoRefreshToken; // con esto lo renuevas si ha caducado, GetAccessToken lo llama si es necesario
  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, // cálculo de hash
  DBXJSON, JsonHelper, // Manejo de JSON
  IdHTTP, IdGlobal,
  SysUtils, StrUtils, ShellAPI, Forms, DateUtils,
  Varios;

{ TOAuth2Authorizer }

// un codificador en base64 especial para el code_verifier
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;

  // montamos un servidor HTTP interno para recibir las respuestas
  fHttpServer := TIdHTTPServer.Create(nil);
  with fHttpServer.Bindings.Add do
  begin
    IP := '127.0.0.1';
    Port := 0;
    IPVersion := Id_IPv4;
  end;
//  FHttpServer.AutoStartSession := True;
//  FHttpServer.SessionState := True;
  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
  // se prepara la llamada para renovar el token
  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;

  // se decodifica la respuesta (JSON)
  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;

// genera un code_verifier necesario en el protocolo OAuth2
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
  // si hay token y no ha caducado salimos
  if fAccessToken <> '' then
  if fExpires > Now then
    Exit;
 
  // si hay RefreshToken lo renovamos y salimos
  if fRefreshToken <> '' then
  begin
    DoRefreshToken;
    Exit;
  end;

  // si llegamos aquí no tenemos token y hay que solicitarlo
  // generamos la petición según el protocolo
  CodeVerifier := GenerarCodeVerifier;
  fCodeResponse := '';

  CodeChallenge := base64url(THash_SHA256.CalcBinary(RawByteString(CodeVerifier)));
  FState := base64url(THash_SHA256.CalcBinary(RawByteString(IntToStr(Random(MaxInt)))));

  // activamos el servidor interno y preparamos la variable con la info de dónde encontrarlo
  fHttpServer.Active := True;

  RedirectUri := IfThen(fSslRedirect, 'https', 'http') + '://localhost:' + IntToStr(fHttpServer.Bindings.Items[0].Port);

  // se prepara la llamada y se manda al navegador del sistema 
  // para que le pida autorización al usuario 
  // y le envíe el resultado al servidor interno
  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);

  // esperamos a lo bestia que el servidor interno procese el resultado (fResponse tendrá valor)
  while fCodeResponse = '' do
    Application.ProcessMessages;

  while fHttpServer.Contexts.Count > 0 do
    Application.ProcessMessages;

  fHttpServer.Active := False;

  if not StartsText('Error', fCodeResponse) then // si no hubo error
  begin
    // tenemos un código de autorización y lo usamos para pedir el token
    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;

//      CheckJsonError(r);

    // si no hubo error en el JSON están todos los valores (tokens, id, caducidad)
    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;

// dónde el servidor interno responde al navegador y guarda la información obtenida
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); // los datos de tu App al registrarte con Google 
    // Truco, para pruebas busca en inet los de Thunderbrid  
    oAuth2Token.Scope := SCOPE_MS_ALL;

    // se pasan los tokens guardados, cadenas vacías la primera vez
    oAuth2Token.UserId := UserId;
    oAuth2Token.RefreshToken := RefreshToken;
    oAuth2Token.AccessToken := AccessToken;
    oAuth2Token.Expires := TokenExpires;

    oAuth2Token.IsSslRedirect := False;
    oAuth2Token.GetAccessToken;

    // Se recogen los nuevos tokens (Y se guardan para el siguiente envío)
    UserId := oAuth2Token.UserId;
    RefreshToken := oAuth2Token.RefreshToken;
    AccessToken := oAuth2Token.AccessToken;
    TokenExpires := oAuth2Token.Expires;

    // y ahora envias el email con el Accesstoken como Password
  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
Responder Con Cita