375 lines
13 KiB
ObjectPascal
375 lines
13 KiB
ObjectPascal
/// shared DDD Infrastructure: Authentication implementation
|
|
// - this unit is a part of the freeware Synopse mORMot framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit dddInfraAuthRest;
|
|
|
|
{
|
|
This file is part of Synopse mORMot framework.
|
|
|
|
Synopse mORMot framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - https://synopse.info
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
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.
|
|
|
|
The Original Code is Synopse mORMot framework.
|
|
|
|
The Initial Developer of the Original Code is Arnaud Bouchez.
|
|
|
|
Portions created by the Initial Developer are Copyright (C) 2022
|
|
the Initial Developer. All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
TODO:
|
|
- manage Authentication expiration?
|
|
|
|
}
|
|
|
|
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
Classes,
|
|
SynCommons,
|
|
SynCrypto,
|
|
SynTests,
|
|
mORMot,
|
|
mORMotDDD,
|
|
dddDomAuthInterfaces;
|
|
|
|
|
|
{ ----- Authentication Implementation using SHA-256 dual step challenge }
|
|
|
|
type
|
|
/// ORM object to persist authentication information, i.e. TAuthInfo
|
|
TSQLRecordUserAuth = class(TSQLRecord)
|
|
protected
|
|
fLogon: RawUTF8;
|
|
fHashedPassword: RawUTF8;
|
|
class procedure InternalDefineModel(Props: TSQLRecordProperties); override;
|
|
published
|
|
/// will map TAuthInfo.LogonName
|
|
// - is defined as "stored AS_UNIQUE" so that it may be used as primary key
|
|
property Logon: RawUTF8 read fLogon write fLogon stored AS_UNIQUE;
|
|
/// the password, stored in a hashed form
|
|
// - this property does not exist at TAuthInfo level, so will be private
|
|
// to the storage layer - which is the safest option possible
|
|
property HashedPassword: RawUTF8 read fHashedPassword write fHashedPassword;
|
|
end;
|
|
|
|
/// generic class for implementing authentication
|
|
// - do not instantiate this abstract class, but e.g. TDDDAuthenticationSHA256
|
|
// or TDDDAuthenticationMD5
|
|
TDDDAuthenticationAbstract = class(TDDDRepositoryRestCommand,IDomAuthCommand)
|
|
protected
|
|
fChallengeLogonName: RawUTF8;
|
|
fChallengeNonce: TAuthQueryNonce;
|
|
fLogged: boolean;
|
|
// inherited classes should override this method with the proper algorithm
|
|
class function DoHash(const aValue: TAuthQueryNonce): TAuthQueryNonce; virtual; abstract;
|
|
public
|
|
/// initiate the first phase of a dual pass challenge authentication
|
|
function ChallengeSelectFirst(const aLogonName: RawUTF8): TAuthQueryNonce;
|
|
/// validate the first phase of a dual pass challenge authentication
|
|
function ChallengeSelectFinal(const aChallengedPassword: TAuthQueryNonce): TCQRSResult;
|
|
/// set the credential for Get() or further IDomAuthCommand.Update/Delete
|
|
// - this method execution will be disabled for most clients
|
|
function SelectByName(const aLogonName: RawUTF8): TCQRSResult;
|
|
/// returns TRUE if the dual pass challenge did succeed
|
|
function Logged: boolean;
|
|
/// returns the logon name of the authenticated user
|
|
function LogonName: RawUTF8;
|
|
/// retrieve some information about the current selected credential
|
|
function Get(out aAggregate: TAuthInfo): TCQRSResult;
|
|
/// register a new credential, from its LogonName/HashedPassword values
|
|
// - on success, the newly created credential will be the currently selected
|
|
function Add(const aLogonName: RawUTF8; aHashedPassword: TAuthQueryNonce): TCQRSResult;
|
|
/// update the current selected credential password
|
|
function UpdatePassword(const aHashedPassword: TAuthQueryNonce): TCQRSResult;
|
|
/// class method to be used to compute a password hash from its plain value
|
|
class function ComputeHashPassword(const aLogonName,aPassword: RawUTF8): TAuthQueryNonce;
|
|
/// class method to be used on the client side to resolve the challenge
|
|
// - is basically
|
|
// ! result := DoHash(aLogonName+':'+aChallengeFromServer+':'+
|
|
// ! ComputeHashPassword(aLogonName,aPlainPassword));
|
|
class function ClientComputeChallengedPassword(
|
|
const aLogonName,aPlainPassword: RawUTF8;
|
|
const aChallengeFromServer: TAuthQueryNonce): TAuthQueryNonce; virtual;
|
|
/// built-in simple unit tests
|
|
class procedure RegressionTests(test: TSynTestCase);
|
|
end;
|
|
|
|
/// allows to specify which actual hashing algorithm would be used
|
|
// - i.e. either TDDDAuthenticationSHA256 or TDDDAuthenticationMD5
|
|
TDDDAuthenticationClass = class of TDDDAuthenticationAbstract;
|
|
|
|
/// implements authentication using SHA-256 hashing
|
|
// - more secure than TDDDAuthenticationMD5
|
|
TDDDAuthenticationSHA256 = class(TDDDAuthenticationAbstract)
|
|
protected
|
|
/// will use SHA-256 algorithm for hashing, and the class name as salt
|
|
class function DoHash(const aValue: TAuthQueryNonce): TAuthQueryNonce; override;
|
|
end;
|
|
|
|
/// implements authentication using MD5 hashing
|
|
// - less secure than TDDDAuthenticationSHA256
|
|
TDDDAuthenticationMD5 = class(TDDDAuthenticationAbstract)
|
|
protected
|
|
/// will use MD5 algorithm for hashing, and the class name as salt
|
|
class function DoHash(const aValue: TAuthQueryNonce): TAuthQueryNonce; override;
|
|
end;
|
|
|
|
/// abstract factory of IDomAuthCommand repository instances using REST
|
|
TDDDAuthenticationRestFactoryAbstract = class(TDDDRepositoryRestFactory)
|
|
protected
|
|
public
|
|
/// initialize a factory with the supplied implementation algorithm
|
|
constructor Create(aRest: TSQLRest; aImplementationClass: TDDDAuthenticationClass;
|
|
aOwner: TDDDRepositoryRestManager); reintroduce;
|
|
end;
|
|
|
|
/// factory of IDomAuthCommand repository instances using a RESTful ORM access
|
|
// and SHA-256 hashing algorithm
|
|
TDDDAuthenticationRestFactorySHA256 = class(TDDDAuthenticationRestFactoryAbstract)
|
|
protected
|
|
public
|
|
/// initialize a factory with the SHA-256 implementation algorithm
|
|
constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager=nil); reintroduce;
|
|
end;
|
|
|
|
/// factory of IDomAuthCommand repository instances using a RESTful ORM access
|
|
// and SHA-256 hashing algorithm
|
|
TDDDAuthenticationRestFactoryMD5 = class(TDDDAuthenticationRestFactoryAbstract)
|
|
protected
|
|
public
|
|
/// initialize a factory with the SHA-256 implementation algorithm
|
|
constructor Create(aRest: TSQLRest; aOwner: TDDDRepositoryRestManager=nil); reintroduce;
|
|
end;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
{ TDDDAuthenticationAbstract }
|
|
|
|
function TDDDAuthenticationAbstract.ChallengeSelectFirst(
|
|
const aLogonName: RawUTF8): TAuthQueryNonce;
|
|
begin
|
|
fLogged := false;
|
|
fChallengeLogonName := Trim(aLogonName);
|
|
fChallengeNonce := DoHash(aLogonName+NowToString);
|
|
result := fChallengeNonce;
|
|
end;
|
|
|
|
function TDDDAuthenticationAbstract.ChallengeSelectFinal(
|
|
const aChallengedPassword: TAuthQueryNonce): TCQRSResult;
|
|
begin
|
|
if (fChallengeLogonName='') or (fChallengeNonce='') then
|
|
result := CqrsSetResultError(cqrsBadRequest) else
|
|
result := SelectByName(fChallengeLogonName);
|
|
if result<>cqrsSuccess then
|
|
exit;
|
|
CqrsBeginMethod(qaNone, result);
|
|
if DoHash(fChallengeLogonName+':'+fChallengeNonce+':'+
|
|
(fCurrentORMInstance as TSQLRecordUserAuth).HashedPassword)=aChallengedPassword then begin
|
|
fLogged := true;
|
|
CqrsSetResult(cqrsSuccess,result);
|
|
end else
|
|
CqrsSetResultMsg(cqrsBadRequest,'Wrong Password for [%]',[fChallengeLogonName],result);
|
|
fChallengeNonce := '';
|
|
fChallengeLogonName := '';
|
|
end;
|
|
|
|
function TDDDAuthenticationAbstract.LogonName: RawUTF8;
|
|
begin
|
|
if (fCurrentORMInstance=nil) or not Logged then
|
|
result := '' else
|
|
result := TSQLRecordUserAuth(fCurrentORMInstance).Logon;
|
|
end;
|
|
|
|
function TDDDAuthenticationAbstract.Logged: boolean;
|
|
begin
|
|
result := fLogged;
|
|
end;
|
|
|
|
class function TDDDAuthenticationAbstract.ComputeHashPassword(
|
|
const aLogonName, aPassword: RawUTF8): TAuthQueryNonce;
|
|
begin
|
|
result := DoHash(aLogonName+':'+aPassword);
|
|
end;
|
|
|
|
class function TDDDAuthenticationAbstract.ClientComputeChallengedPassword(
|
|
const aLogonName,aPlainPassword: RawUTF8; const aChallengeFromServer: TAuthQueryNonce): TAuthQueryNonce;
|
|
begin // see TDDDAuthenticationAbstract.ChallengeSelectFinal
|
|
result := DoHash(aLogonName+':'+aChallengeFromServer+':'+
|
|
ComputeHashPassword(aLogonName,aPlainPassword));
|
|
end;
|
|
|
|
function TDDDAuthenticationAbstract.SelectByName(
|
|
const aLogonName: RawUTF8): TCQRSResult;
|
|
begin
|
|
result := ORMSelectOne('Logon=?',[aLogonName],(aLogonName=''));
|
|
end;
|
|
|
|
function TDDDAuthenticationAbstract.Get(
|
|
out aAggregate: TAuthInfo): TCQRSResult;
|
|
begin
|
|
result := ORMGetAggregate(aAggregate);
|
|
end;
|
|
|
|
function TDDDAuthenticationAbstract.Add(const aLogonName: RawUTF8;
|
|
aHashedPassword: TAuthQueryNonce): TCQRSResult;
|
|
begin
|
|
if not CqrsBeginMethod(qaCommandDirect,result) then
|
|
exit;
|
|
with fCurrentORMInstance as TSQLRecordUserAuth do begin
|
|
Logon := aLogonName;
|
|
HashedPassword := aHashedPassword;
|
|
end;
|
|
ORMPrepareForCommit(soInsert,nil,result);
|
|
end;
|
|
|
|
function TDDDAuthenticationAbstract.UpdatePassword(
|
|
const aHashedPassword: TAuthQueryNonce): TCQRSResult;
|
|
begin
|
|
if not CqrsBeginMethod(qaCommandOnSelect,result) then
|
|
exit;
|
|
(fCurrentORMInstance as TSQLRecordUserAuth).HashedPassword := aHashedPassword;
|
|
ORMPrepareForCommit(soUpdate,nil,result);
|
|
end;
|
|
|
|
class procedure TDDDAuthenticationAbstract.RegressionTests(
|
|
test: TSynTestCase);
|
|
var Factory: TDDDAuthenticationRestFactoryAbstract;
|
|
procedure TestOne;
|
|
const MAX=2000;
|
|
var auth: IDomAuthCommand;
|
|
nonce,challenge: TAuthQueryNonce;
|
|
log,pass: RawUTF8;
|
|
info: TAuthInfo;
|
|
i: integer;
|
|
begin
|
|
test.Check(Factory.GetOneInstance(auth));
|
|
for i := 1 to MAX do begin
|
|
UInt32ToUtf8(i,log);
|
|
UInt32ToUtf8(i*7,pass);
|
|
test.Check(auth.Add(log,ComputeHashPassword(log,pass))=cqrsSuccess);
|
|
end;
|
|
test.Check(auth.Commit=cqrsSuccess);
|
|
test.Check(Factory.GetOneInstance(auth));
|
|
info := TAuthInfo.Create;
|
|
try
|
|
for i := 1 to MAX do begin
|
|
UInt32ToUtf8(i,log);
|
|
UInt32ToUtf8(i*7,pass);
|
|
nonce := auth.ChallengeSelectFirst(log);
|
|
test.Check(nonce<>'');
|
|
challenge := ClientComputeChallengedPassword(log,pass,nonce);
|
|
test.Check(auth.ChallengeSelectFinal(challenge)=cqrsSuccess);
|
|
test.Check(auth.Get(info)=cqrsSuccess);
|
|
test.Check(info.LogonName=log);
|
|
end;
|
|
finally
|
|
info.Free;
|
|
end;
|
|
end;
|
|
var Rest: TSQLRestServerFullMemory;
|
|
begin
|
|
Rest := TSQLRestServerFullMemory.CreateWithOwnModel([TSQLRecordUserAuth]);
|
|
try
|
|
Factory := TDDDAuthenticationRestFactoryAbstract.Create(Rest,self,nil);
|
|
try
|
|
TestOne; // sub function to ensure that all I*Command are released
|
|
finally
|
|
Factory.Free;
|
|
end;
|
|
finally
|
|
Rest.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TDDDAuthenticationSHA256 }
|
|
|
|
class function TDDDAuthenticationSHA256.DoHash(
|
|
const aValue: TAuthQueryNonce): TAuthQueryNonce;
|
|
begin
|
|
result := SHA256(RawUTF8(ClassName)+aValue);
|
|
end;
|
|
|
|
{ TDDDAuthenticationMD5 }
|
|
|
|
class function TDDDAuthenticationMD5.DoHash(
|
|
const aValue: TAuthQueryNonce): TAuthQueryNonce;
|
|
begin
|
|
result := MD5(RawUTF8(ClassName)+aValue);
|
|
end;
|
|
|
|
|
|
{ TDDDAuthenticationRestFactoryAbstract }
|
|
|
|
constructor TDDDAuthenticationRestFactoryAbstract.Create(aRest: TSQLRest;
|
|
aImplementationClass: TDDDAuthenticationClass;
|
|
aOwner: TDDDRepositoryRestManager);
|
|
begin
|
|
inherited Create(
|
|
IDomAuthCommand,aImplementationClass,TAuthInfo,aRest,TSQLRecordUserAuth,
|
|
['Logon','LogonName'],aOwner);
|
|
end;
|
|
|
|
|
|
{ TDDDAuthenticationRestFactorySHA256 }
|
|
|
|
constructor TDDDAuthenticationRestFactorySHA256.Create(aRest: TSQLRest;
|
|
aOwner: TDDDRepositoryRestManager);
|
|
begin
|
|
inherited Create(aRest,TDDDAuthenticationSHA256,aOwner);
|
|
end;
|
|
|
|
{ TDDDAuthenticationRestFactoryMD5 }
|
|
|
|
constructor TDDDAuthenticationRestFactoryMD5.Create(aRest: TSQLRest;
|
|
aOwner: TDDDRepositoryRestManager);
|
|
begin
|
|
inherited Create(aRest,TDDDAuthenticationMD5,aOwner);
|
|
end;
|
|
|
|
|
|
|
|
{ TSQLRecordUserAuth }
|
|
|
|
class procedure TSQLRecordUserAuth.InternalDefineModel(
|
|
Props: TSQLRecordProperties);
|
|
begin
|
|
AddFilterNotVoidText(['Logon','HashedPassword']);
|
|
end;
|
|
|
|
end.
|