Generování 2FA TOTP v Delphi

Generování 2FA TOTP v Delphi - tento poněkud kryptický nadpis znamená dvou faktorovou autentizaci na bázi TOTP (Time-based One-Time Password), tj. časově závislé jednorázové heslo.
V podstatě je to to, co generují aplikace jako Google Authenticator, Microsoft Authenticator nebo Duo Mobile (bez módu push). Výhodou je řešení zdarma, plně pod vaší kontrolou spolupracující s libovolnou aplikací.

Jak to tedy funguje? Server i vaše aplikace sdílejí "tajný klíč" (seed). Oba mají synchronizovaný čas. Pomocí matematického algoritmu (HMAC-SHA1) vypočítají ve stejný okamžik stejné číslo (platné pro zadaný interval cca 30s) a aplikace ho zobrazí, uživatel zadá a vy ho porovnáte s tím co si vygeneruje sami (na obrázku to 115416).

Výhodou je, že mobil nepotřebuje internet, kód se prostě vygeneruje offline na základě času.





Problém má dvě části:

• generování QR kódu s daty pro uživatele pro registraci v aplikaci typu DuoMobile nebo Microsoft Authenticator
• ověřování kódu pro přihlášení

Použijeme dvě open source knihovny (obecně nemám rád pro každou blbost mít komponentu), takže oceňuji, že jsou to třídy.

• DelphiZXingQRCode - port QR Code ze ZXing do Delphi od Foxit
• rad-authenticator - autor Darian Miller (Delphi MVP)

Mimochodem DelphiZXingQRCode je pecka, protože je to čistě implementace QR do boolean matice, takže se krásně dá použít i jako server side řešení.
V mém sample jsem vzal sample právě z DelphiZXingQRCode a přidal jsem volání rad-authenticator, a to speciálně věci ohledně TBase32 kódování.

V praxi to secret key má být samozřejmě secret, a použije se pro vytvoření Auth URL, které se předhodí pro generování QR - procedura BuildOtpAuthUrl a TForm1.Update, a výsledek se vykreslí přes PaintBox1Paint. No není to elegantní?

Vlastní ověření je pak jednoduše vygenerování čísla pro porovnání se zadanou hodnotou. Všimněte si, že v tom AuthURL je interval / Period.


edtPassword.Text := TTOTP.GeneratePassword(edtSecretKey.Text);


Celý kód:

unit DelphiZXingQRCodeTestAppMainForm;


interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DelphiZXingQRCode, Vcl.ExtCtrls,
Vcl.StdCtrls, radRTL.TOTP;

type
TForm1 = class(TForm)
edtText: TEdit;
Label1: TLabel;
cmbEncoding: TComboBox;
Label2: TLabel;
Label3: TLabel;
edtQuietZone: TEdit;
Label4: TLabel;
PaintBox1: TPaintBox;
Button1: TButton;
edtPassword: TEdit;
edtSecretKey: TEdit;
edtEmail: TEdit;
Label5: TLabel;
edtIssuer: TEdit;
Label6: TLabel;
Button2: TButton;
Label7: TLabel;
Label8: TLabel;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure edtTextChange(Sender: TObject);
procedure cmbEncodingChange(Sender: TObject);
procedure edtQuietZoneChange(Sender: TObject);
private
QRCodeBitmap: TBitmap;
public
procedure Update;
end;

var
Form1: TForm1;

implementation
uses
system.NetEncoding, radRTL.Base32Encoding, System.Hash;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
edtPassword.Text := TTOTP.GeneratePassword(edtSecretKey.Text);
end;

procedure TForm1.cmbEncodingChange(Sender: TObject);
begin
Update;
end;

procedure TForm1.edtQuietZoneChange(Sender: TObject);
begin
Update;
end;

procedure TForm1.edtTextChange(Sender: TObject);
begin
Update;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
edtSecretKey.Text := 'IVXWIVDJHFUEE3TPPFHDCMCHNZSSWT2R';
QRCodeBitmap := TBitmap.Create;
Update;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
QRCodeBitmap.Free;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
Scale: Double;
begin
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height));
if ((QRCodeBitmap.Width > 0) and (QRCodeBitmap.Height > 0)) then
begin
if (PaintBox1.Width < PaintBox1.Height) then
begin
Scale := PaintBox1.Width / QRCodeBitmap.Width;
end else
begin
Scale := PaintBox1.Height / QRCodeBitmap.Height;
end;
PaintBox1.Canvas.StretchDraw(Rect(0, 0, Trunc(Scale QRCodeBitmap.Width), Trunc(Scale QRCodeBitmap.Height)), QRCodeBitmap);
end;
end;


function BuildOtpAuthUrl(
const AIssuer: string;
const AAccountName: string;
const ASecretBase32: string;
ADigits: Integer = 6;
APeriod: Integer = 30;
const AAlgorithm: string = 'SHA1'
): string;
var
LabelPart: string;
begin
// issuer:account
LabelPart :=
TNetEncoding.URL.Encode(AIssuer + ':' + AAccountName);

Result :=
'otpauth://totp/' + LabelPart +
'?secret=' + TNetEncoding.URL.Encode(ASecretBase32) +
'&issuer=' + TNetEncoding.URL.Encode(AIssuer) +
'&algorithm=' + UpperCase(AAlgorithm) +
'&digits=' + ADigits.ToString +
'&period=' + APeriod.ToString;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
edtText.Text := BuildOtpAuthUrl(edtIssuer.Text, edtEmail.Text, edtSecretKey.Text);
end;


procedure TForm1.Button3Click(Sender: TObject);
var
s: string;
x: Integer;
begin
s := TGuid.NewGuid.ToString.Substring(1, 36);
// edtSecretKey.Text := Base32.Encode('plain password')


edtSecretKey.Text := TBase32.Encode(s);
end;

procedure TForm1.Update;
var
QRCode: TDelphiZXingQRCode;
Row, Column: Integer;
begin
QRCode := TDelphiZXingQRCode.Create;
try
QRCode.Data := edtText.Text;
QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4);
QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns);
for Row := 0 to QRCode.Rows - 1 do
begin
for Column := 0 to QRCode.Columns - 1 do
begin
if (QRCode.IsBlack[Row, Column]) then
begin
QRCodeBitmap.Canvas.Pixels[Column, Row] := clBlack;
end else
begin
QRCodeBitmap.Canvas.Pixels[Column, Row] := clWhite;
end;
end;
end;
finally
QRCode.Free;
end;
PaintBox1.Repaint;
end;

end.


Datum: 2026-07-02T21:04
Tagy: Delphi

Kategorie: Praxe