Delphi - Device Authorization Flow With IMAP（OAuth2.0

~~由於微軟不支持Client Credentials Flow而且IMAP連接官方也有建議使用的OAuth兩種流程，其中一個是前幾篇介紹的Authorization Code Flow~~，這次就來實作Device Authorization Flow看看吧！

2022/06/30 新增IMAP、POP、SMTP的Client Credentials Flow！直接使用就對了！點我前往參考連接

元件準備

前兩篇都是直接使用「TsgcHTTP_OAuth2_Client」這個元件，但是它只有供Authorization Code Flow和Client Credentials Flow兩種流程，所以這次我們要自己實作Device Authorization Flow的完整流程，首先先添加一個TButton準備起來

這裡我實作了一個專屬Device Authorization Flow的Class

unit DeviceAuthFlow;

interface

uses System.Classes, System.SysUtils, System.JSON, System.Threading, System.Net.URLClient, Winapi.ShellAPI, FMX.Types, IdHTTP;

type
  TOnAfterAuthorizeCode = reference to procedure(AuthCode: string);
  TOnAfterAuthorizeGetExpireTime = reference to procedure(ExpireTime: Integer);
  TOnErrorAccessToken = reference to procedure(Error, ErrorDescription: string);
  TOnAfterAccessToken = reference to procedure(Device_ID, Access_Token, Token_Type: string; Expires_In: Integer; Scope: string);

  TDevice_Authorization_Flow = class
  const
    DEVICECODEAUTHURL = 'https://login.microsoftonline.com/%s/oauth2/v2.0/devicecode'; // Device Code Auth URL
    CLIENTIDSTRING = 'client_id=%s'; // Device Code Auth/Token post data -> client id
    SCOPESTRING = 'scope=%s'; // Device Code Auth post data -> scope
    DEVICECODETOKENURL = 'https://login.microsoftonline.com/%s/oauth2/v2.0/token'; // Device Code Token URL
    GRANTTYPESTRING = 'grant_type=urn:ietf:params:oauth:grant-type:device_code'; // Device Code Token post data -> grant type
    DEVICECODESTRING = 'device_code=%s'; // Device Code Token post data -> device code
  type
    TResponse = record
      ResponseCode: Integer;
      ResponseText: string;
    end;
  strict private
    FTenantID: string;
    FScope: string;
    FClientID: string;
    FDevice_Code: string;
    FVerification_URI: string;
    FExpire_In: Integer;
    FInterval: Integer;
    IdHTTP_Device_Authorization: TIdHTTP;
    FTimer_Device_Auth_Interval: TTimer;
    FOnAfterAuthorizeCode: TOnAfterAuthorizeCode;
    FOnAfterAuthorizeGetExpireTime: TOnAfterAuthorizeGetExpireTime;
    FOnAfterAccessToken: TOnAfterAccessToken;
    FOnErrorAccessToken: TOnErrorAccessToken;
    procedure OnCalExpireTimer(Sender: TObject);
    procedure OpenVerification_URI;
    procedure StartAuthLoop;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Start;
    property TenantID: string read FTenantID write FTenantID;
    property ClientID: string read FClientID write FClientID;
    property Scope: string read FScope write FScope;
    property OnAfterAuthorizeCode: TOnAfterAuthorizeCode read FOnAfterAuthorizeCode write FOnAfterAuthorizeCode;
    property OnAfterAuthorizeGetExpireTime: TOnAfterAuthorizeGetExpireTime read FOnAfterAuthorizeGetExpireTime write FOnAfterAuthorizeGetExpireTime;
    property OnAfterAccessToken: TOnAfterAccessToken read FOnAfterAccessToken write FOnAfterAccessToken;
    property OnErrorAccessToken: TOnErrorAccessToken read FOnErrorAccessToken write FOnErrorAccessToken;
  end;

implementation

{ TDevice_Authorization_Flow }
constructor TDevice_Authorization_Flow.Create;
begin
  FClientID := '';
  FTenantID := '';
  FScope := '';
  IdHTTP_Device_Authorization := TIdHTTP.Create(nil);
  IdHTTP_Device_Authorization.Request.ContentEncoding := 'UTF-8';
  IdHTTP_Device_Authorization.Request.ContentType := 'application/x-www-form-urlencoded';
  FTimer_Device_Auth_Interval := TTimer.Create(nil);
  FTimer_Device_Auth_Interval.Enabled := False;
  FTimer_Device_Auth_Interval.OnTimer := OnCalExpireTimer;
end;

destructor TDevice_Authorization_Flow.Destroy;
begin
  if Assigned(IdHTTP_Device_Authorization) then FreeAndNil(IdHTTP_Device_Authorization);
  if Assigned(FTimer_Device_Auth_Interval) then FreeAndNil(FTimer_Device_Auth_Interval);
  inherited;
end;

procedure TDevice_Authorization_Flow.OnCalExpireTimer(Sender: TObject);
begin
  if FExpire_In <> 0 then begin
    FExpire_In := FExpire_In - 1;
    if Assigned(FOnAfterAuthorizeGetExpireTime) then FOnAfterAuthorizeGetExpireTime(FExpire_In);
  end else begin
    FTimer_Device_Auth_Interval.Enabled := False;
  end;
end;

procedure TDevice_Authorization_Flow.OpenVerification_URI;
var
  FURI: TURI;
begin
  if FVerification_URI <> '' then begin
    FURI := TURI.Create(FVerification_URI);
    ShellExecute(0, 'open', PChar(FURI.ToString), nil, nil, 0);
  end;
end;

procedure TDevice_Authorization_Flow.Start;
var
  postData: TStrings;
  FResponseString: string;
  FResponseJSON: TJSONObject;
begin
  if (FClientID <> '') and
     (FTenantID <> '') and
     (FScope <> '') then begin
    try
      // Post Data
      postData := TStringList.Create;
      postData.Add(Format(CLIENTIDSTRING, [FClientID]));
      postData.Add(Format(SCOPESTRING, [FScope]));
      // Call Device Auth API
      FResponseString := IdHTTP_Device_Authorization.Post(Format(DEVICECODEAUTHURL, [FTenantID]), postData);
      // Response JSON
      FResponseJSON := TJSONObject.ParseJSONValue(FResponseString) as TJSONObject;
      FDevice_Code := FResponseJSON.GetValue('device_code').AsType<string>;
      FVerification_URI := FResponseJSON.GetValue('verification_uri').AsType<string>;
      FExpire_In := FResponseJSON.GetValue('expires_in').AsType<Integer>;
      FInterval := FResponseJSON.GetValue('interval').AsType<Integer>;
      // Callback Auth Code
      if Assigned(FOnAfterAuthorizeCode) then FOnAfterAuthorizeCode(FResponseJSON.GetValue('user_code').AsType<string>);
      // Start Cal Expire Time
      FTimer_Device_Auth_Interval.Enabled := True;
      // Open verification uri
      OpenVerification_URI;
      // Auth Loop
      StartAuthLoop;
    finally
      if Assigned(postData) then FreeAndNil(postData);
      if Assigned(FResponseJSON) then FreeAndNil(FResponseJSON);
    end;
  end else begin
    raise Exception.Create('Not set Client ID or Tenant ID or Scope');
  end;
end;

procedure TDevice_Authorization_Flow.StartAuthLoop;
var
  aTask: IFuture<TResponse>;
begin
  // Start Task
  aTask := TTask.Future<TResponse>(function: TResponse
  var
    IdHTTP_Device_Token: TIdHTTP;
    postData: TStrings;
    FErrResponseJSON: TJSONObject;
    FTID: string;
    FCID: string;
    FDCOD: string;
    FITT: Integer;
    FError: string;
  begin
    try
      Result.ResponseCode := 400;
      Result.ResponseText := '';
      FTID := FTenantID;
      FCID := FClientID;
      FDCOD := FDevice_Code;
      FITT := FInterval * 1000;
      IdHTTP_Device_Token := TIdHTTP.Create(nil);
      IdHTTP_Device_Token.Request.ContentEncoding := 'UTF-8';
      IdHTTP_Device_Token.Request.ContentType := 'application/x-www-form-urlencoded';
      // Post Data
      postData := TStringList.Create;
      postData.Add(GRANTTYPESTRING);
      postData.Add(Format(DEVICECODESTRING, [FDCOD]));
      postData.Add(Format(CLIENTIDSTRING, [FCID]));
      repeat
        Sleep(FITT);
        try
          // Call Device Auth API
          Result.ResponseText := IdHTTP_Device_Token.Post(Format(DEVICECODETOKENURL, [FTID]), postData);
          Result.ResponseCode := 200;
        except
          on E: EIdHTTPProtocolException do begin
            // Http Error
            FErrResponseJSON := TJSONObject.ParseJSONValue(E.ErrorMessage) as TJSONObject;
            FError := FErrResponseJSON.GetValue('error').AsType<string>;
            // Expired token or Authorization Declined
            if (FError = 'expired_token') or (FError = 'authorization_declined') then begin
              Result.ResponseText := E.ErrorMessage;
              break;
            end;
            if Assigned(FErrResponseJSON) then FreeAndNil(FErrResponseJSON);
          end;
        end;
      until Result.ResponseCode = 200;
    finally
      if Assigned(postData) then FreeAndNil(postData);
      if Assigned(IdHTTP_Device_Token) then FreeAndNil(IdHTTP_Device_Token);
    end;
  end);
  aTask.Start;

  // Get Task Result
  TTask.Run(procedure()
  var
    FResponseJSON: TJSONObject;
  begin
    try
      // Wait aTask For Access Token Response
      TTask.WaitForAny([aTask]);
      // Callback Access Token Response
      FTimer_Device_Auth_Interval.Enabled := False;
      FResponseJSON := TJSONObject.ParseJSONValue(aTask.Value.ResponseText) as TJSONObject;
      if aTask.Value.ResponseCode = 200 then begin
        TThread.Synchronize(nil, procedure begin if Assigned(FOnAfterAccessToken) then FOnAfterAccessToken(FDevice_Code,
                                                                                                           FResponseJSON.GetValue('access_token').AsType<string>,
                                                                                                           FResponseJSON.GetValue('token_type').AsType<string>,
                                                                                                           FResponseJSON.GetValue('expires_in').AsType<Integer>,
                                                                                                           FResponseJSON.GetValue('scope').AsType<string>) end);
      end else begin
        TThread.Synchronize(nil, procedure begin if Assigned(OnErrorAccessToken) then OnErrorAccessToken(FResponseJSON.GetValue('error').AsType<string>, FResponseJSON.GetValue('error_description').AsType<string>); end);
      end;
    finally
      if Assigned(FResponseJSON) then FreeAndNil(FResponseJSON);
    end;
  end);
end;
end.

接著到FormCreate裡面建立起Device Authorization Flow的物件並且給予所需要的屬性和事件

//Device Authorization Flow
FDevice_Authorization_Flow := TDevice_Authorization_Flow.Create;
FDevice_Authorization_Flow.TenantID := '你的租用戶識別碼';
FDevice_Authorization_Flow.ClientID := '你的應用程式識別碼';
FDevice_Authorization_Flow.Scope := 'https://outlook.office.com/IMAP.AccessAsUser.All';
FDevice_Authorization_Flow.OnAfterAuthorizeCode := procedure(AuthCode: string)
begin
  btn_Device_Auth_Flow.Enabled := False;
  DoLog('Your Auth Code: ' + AuthCode);
end;
FDevice_Authorization_Flow.OnAfterAuthorizeGetExpireTime := procedure(ExpireTime: Integer)
begin
  btn_Device_Auth_Flow.Text := 'Use Device Authorization Flow - ' + IntToStr(ExpireTime) + 's';
end;
FDevice_Authorization_Flow.OnAfterAccessToken := procedure(Device_ID, Access_Token, Token_Type: string; Expires_In: Integer; Scope: string)
begin
  btn_Device_Auth_Flow.Enabled := True;
  btn_Device_Auth_Flow.Text := 'Use Device Authorization Flow';
  DoLog('Device_ID: ' + Device_ID + CRLF +
        'AccessToken: ' + Access_Token + CRLF +
        'Token_Type: ' + Token_Type + CRLF +
        'Expires_In: ' + IntToStr(Expires_In) + CRLF +
        'Scope: ' + Scope);
  TIdSASLXOAuth(xOAuthSASL.SASL).Token := Access_Token;
  TIdSASLXOAuth(xOAuthSASL.SASL).ExpireTime := IntToStr(Expires_In);
  TIdSASLXOAuth(xOAuthSASL.SASL).User := 'ltrfq@lihta.onmicrosoft.com'; // outlook email account
end;
FDevice_Authorization_Flow.OnErrorAccessToken := procedure(Error, ErrorDescription: string)
begin
  btn_Device_Auth_Flow.Text := 'Use Device Authorization Flow';
  DoLog('Error: ' + Error + CRLF +
        'Error_Description: ' + ErrorDescription);
  btn_Device_Auth_Flow.Enabled := True;
end;

屬性

TenantID：租用戶識別碼
ClientID：用戶識別碼，直接帶入Azure AD的應用程式識別碼
Scope：請求的權限

事件

OnAfterAuthorizeCode：取得驗證碼的Callback

procedure(AuthCode: string)
begin
  btn_Device_Auth_Flow.Enabled := False;
  DoLog('Your Auth Code: ' + AuthCode);
end;

OnAfterAuthorizeGetExpireTime：驗證碼取得後剩餘事件Callback

procedure(ExpireTime: Integer)
begin
  btn_Device_Auth_Flow.Text := 'Use Device Authorization Flow - ' + IntToStr(ExpireTime) + 's';
end;

OnAfterAccessToken：取得Access Token的Callback

procedure(Access_Token, Token_Type: string; Expires_In: Integer; Scope: string)
begin
  btn_Device_Auth_Flow.Enabled := True;
  btn_Device_Auth_Flow.Text := 'Use Device Authorization Flow';
  DoLog('AccessToken: ' + Access_Token + CRLF +
        'Token_Type: ' + Token_Type + CRLF +
        'Expires_In: ' + IntToStr(Expires_In) + CRLF +
        'Scope: ' + Scope);
  TIdSASLXOAuth(xOAuthSASL.SASL).Token := Access_Token;
  TIdSASLXOAuth(xOAuthSASL.SASL).ExpireTime := IntToStr(Expires_In);
  TIdSASLXOAuth(xOAuthSASL.SASL).User := '你要授權登入的公用電子郵件名稱@xxx.onmicrosoft.com';
end;

💡 這的公用電子郵件名稱必須是你一開始執行設備驗證時所登入的公用帳號

OnErrorAccessToken：取得Access Token的錯誤Callback

procedure(Error, ErrorDescription: string)
begin
  DoLog('Error: ' + Error + CRLF +
        'Error_Description: ' + ErrorDescription);
  btn_Device_Auth_Flow.Enabled := True;
end;

以上都完成後再TButton事件裡面加入啟動流程

procedure TForm1.btn_Device_Auth_FlowClick(Sender: TObject);
begin
  DoLog('Start Device Authorization Flow');
  FDevice_Authorization_Flow.Start;
end;

執行Device Authorization Flow

我們啟動程式直接執行就可以開始整個Device Authorization Flow的流程並依照步驟把驗證碼帶入開啟的網頁

成功！順利連線也成功取得Mail的數量

💡 如果是特殊設備可以產生一個QRCode提供使用者用他個人的行動裝置掃描登入

如果超過驗證時間也會回傳錯誤訊息

總結

完成實作後是不是覺得跟Authorization Code Flow一樣呢？兩者雖然流程和驗證方式不盡相同，但是最終還是必須透過所謂的「Resource Owner（這裡指的是人）」去做介入，這樣的方式仍然不是我們需求所要的因此這個方式還是不行啊！ ~~所以最終只剩下一個Flow可以使用！那就是最危險也最不安全的「ROPC（Resource Owner Password Credentials）」了~~，我們下個章節見！

程式碼下載：【Delphi-OAuth2IMAP】

Let's Coding - 開發實錄

Delphi - Device Authorization Flow With IMAP（OAuth2.0 - 系列3）

元件準備

屬性

事件

執行Device Authorization Flow

總結

張貼者： MomoChenIsMe

0 Comments

張貼留言

聯絡表單