mORMot Open Source

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Restrict connections count

Hello,

This is possible to resctict maximum connections to the server?

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

You can use TSQLRestServer.OnSessionCreate callback.

See http://synopse.info/forum/viewtopic.php?id=2306

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Thanks, please correct me if I'm wrong:

  DB := TSQLRestServerDB.Create(Model, sFile, False, 'NPM_5.x_Version');
  DB.CreateMissingTables;
  DB.TrackChanges([TSQLRec]);
  DB.ServiceRegister(TFullRecs, [TypeInfo(IFullRecs)], sicShared);
  DB.OnSessionCreate := OnSessionCreate;
  DB.OnSessionClosed := OnSessionClosed;
  Server := TSQLHttpServer.Create(SERVER_PORT, [DB], '+', HTTP_DEFAULT_MODE);
  Server.AccessControlAllowOrigin := '*';

I'm connect from client and work, but events OnSessionCreate and OnSessionClosed never fired

On client side:
    Client := TSQLHttpClient.Create('localhost', AnsiString(SERVER_PORT), Model);
    Result := Client.ServerTimeStampSynchronize;
    if Result then begin
      (Client as TSQLHttpClientGeneric).KeepAliveMS := 30000;
      (Client as TSQLHttpClientGeneric).Compression := [hcSynShaAes];
      Client.ServiceRegister([TypeInfo(IFullRecs)], sicShared);
    end

Last edited by EgorovAlex (2015-02-28 10:28:19)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

As stated by the documentation, those events are fired for each authenticated session.
You need to enable authentication to be able to count!

If you want to disconnect from plain HTTP connections, this is a pretty wrong idea IMHO: anybody may try to connect to your HTTP server, so only authenticated clients should be taken in account.

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

This was my second question about anonimous access and how to restrict it. Try to research docs

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

There is no such feature directly available yet at TSQLRestServer level.

But you have the following property for THttpAPIServer:

    /// the maximum number of HTTP connections allowed (via HTTP API 2.0)
    // - Setting this value to 0 allows an unlimited number of connections
    // - by default Windows not limit number of allowed connections
    // - will return 0 if the system does not support HTTP API 2.0 (i.e.
    // under Windows XP or Server 2003)
    property MaxConnections: Cardinal read GetMaxConnections write SetMaxConnections;

BTW, what is your exact reason of implementing it?

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Currently I need feature to limit max sessions with database - this is different licenses.
Client should establish connection with server using selected port number if available free sessiong,
send login and password (encrypted), server should check this user/password pair and authorize client
user/password - windows domain\login and password.
Client computer may be not in domain and this is reason to check user/password on the server side.

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

Why not just use a mORMot session and its authentication schemes for this?

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

If I understand correct with mORMot per user authentication I should use files with users and groups and server should know passwords (or hashes).
In my situation server don't know passwords, he will send password check request to the domain controller or this method supports too?

Additional description: in my situation customer type login/password in my program, this is login/password from active directory, but this can differ from currently logged user and can be changed at any time, one customer can login with different logins to get different access rights for the program content

Last edited by EgorovAlex (2015-02-28 15:27:24)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

There are several authentication schemes in mORMot.
You can in fact create your own authentication mechanism if needed.

The TSQLRestServerAuthenticationSSPI class implements direct domain authentication of the Windows logged user in mORMot.
See http://synopse.info/files/html/Synopse% … l#TITL_121

Edit: To allow domain validation of logon/password credential, you can create a TSQLRestServerAuthenticationSSPI like class and include it into the mORMot authentication mechanism.
It would be much better, since it would be integrated with other framework SOA features, e.g. authorization and execution monitoring/statistics.

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Thanks again for your answer, as usual happen - many questions and misunderstanding for the first project in new environment

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

If you create a new authentication class, to check the logon/password against a Windows domain, we may help debugging it and include it in the framework trunk.

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

I'm ready to create, but first I should understand how it works for already created classes

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Hm... I'm confused. I make the same steps as for 14 Example with Weak authentication, but my client received 'Forbidden' error from server.
Read sample line by line, make the same... Where I'm wrong? Something should I add to TSQLAuthUser? But in sample I can't found any code which do it

Edit: found initialization by default for user 'User' but still don't understand reason for Forbidden in my client

Edit2: fixed, this is my error: was used HTTP_DEFAULT_MODE for http server, with useHttpApiRegisteringURI works fine

Last edited by EgorovAlex (2015-03-01 20:02:27)

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Can you clarify, why in 14 Example Server Weak if I change

    aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,false);
to
    aServer := TSQLRestServerDB.Create(aModel, ExeVersion.ProgramFilePath + 'Test.db3', False, '');
    aServer.CreateMissingTables;

after this I receive in 04 Client: 403 Forbidden
(aServer type changed to TSQLRestServerDB in var section)

Last edited by EgorovAlex (2015-03-01 20:02:11)

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Still trying to understand, can't use the sample 14 Server External, whe run got exception:

20150302 13352207 SQL       TSQLDBSQLite3Statement(0211C3E8) Project14ServerExternal.db PRAGMA table_info(`AuthGroup`)
20150302 13352207 SQL       TSQLDBSQLite3Statement(0211C5A0) Project14ServerExternal.db PRAGMA index_list(`AuthGroup`)
20150302 13352207 debug     TSQLRestStorageExternal(022691B0) GetFields=[]
20150302 13352402 EXCOS     EAccessViolation (C0000005) at 00406D43  stack trace API 005345F0 00534618 00409E94
20150302 13352402 SQL       TSQLDBSQLite3Statement(0211C3E8) Error {"EAccessViolation(020F9390)":{}} on Project14ServerExternal.db for "CREATE TABLE AuthGroup (ID INTEGER NOT NULL PRIMARY KEY,Ident TEXT COLLATE SYSTEMNOCASE NOT NULL UNIQUE,SessionTimeout INTEGER,AccessRights TEXT COLLATE SYSTEMNOCASE)" as "CREATE TABLE AuthGroup (ID INTEGER NOT NULL PRIMARY KEY,Ident TEXT COLLATE SYSTEMNOCASE NOT NULL UNIQUE,SessionTimeout INTEGER,AccessRights TEXT COLLATE SYSTEMNOCASE)"
20150302 13352402 EXCOS     EAccessViolation (C0000005) at 00406D43  stack trace API 005345F0 00534618 00409E94
20150302 13352500 EXC       ESQLite3Exception {"ErrorCode":0,"Message":"Error SQLITE_ERROR (1) - \"no such table: AuthGroup\" extended_errcode=1"} at 005CA6B3  stack trace API 005345F0 00534618 00409E94
20150302 13352544 EXC       EORMException {"Message":"TSQLRestStorageExternal.Create: TSQLAuthGroup: unable to create external missing field AuthGroup.Ident - SQL=\"ALTER TABLE AuthGroup ADD Ident TEXT COLLATE SYSTEMNOCASE NOT NULL UNIQUE\""} at 005E97C9  stack trace API 005345F0 00534618 00409D0C 7795DF53 7795DDBB 005E97C9 005B0497 005D0D1C 0063606E 0063640B 006162B8 0060F47A 0060F593 005CA059 005C8D7A 005C8E27 005C63E7 005CD221 0065A168 7772495D 779698EE 779698C4

Edit: this occured on the line 43:         CreateMissingTables;
As I can see is needed AuthGroup, but I think this sample should works out of the box, without any additionals from customer?

Last edited by EgorovAlex (2015-03-02 09:49:27)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

I just tried to compile and run Project14ServerExternal.dpr with Delphi 7 and Delphi XE7, with no problem.

Your SQLite3 wrapper sounds broken.
Did you get the latest .obj ?
Is your framework source up-to-date?

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

All files was downloaded this morning, but after downloading mORMot ans SQLite obj files now this sample works, possible was error with copying some files

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

User authentication by Active Directory Login\Password

Usage on the server side:

  aModel := TSQLModel.Create([TSQLAuthGroupAD,TSQLAuthUser],ROOT_NAME);
  aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,false);
  aServer.AuthenticationRegister(TSQLRestServerAuthenticationAD);

On the client side:

  TSQLRestServerAuthenticationAD.ClientSetUser(Client,'Domain\Login','Password'); 

Actually this is possible to use without active dirctory using format 'ComputerName\Login'
Here ComputerName should be name of computer where server is started
 
 
TSQLAuthGroupAD contain one default user '*'
settings from this user will be applied to any authenticated user which not contain record with restrictions
in other words all authenticated users will have 'User' access

Your comments will be highly appreciated

type
  TSQLRestServerAuthenticationAD = class(TSQLRestServerAuthenticationSignedURI)
  protected
    function CheckPassword(Ctxt: TSQLRestServerURIContext;
      const aClientNonce, aUserName, aPassWord, aData: RawUTF8): boolean; virtual;
    class function ClientComputeSessionKey(Sender: TSQLRestClientURI; User: TSQLAuthUser): RawUTF8; override;
  public
    function Auth(Ctxt: TSQLRestServerURIContext): boolean; override;
    class function ClientSetUser(Sender: TSQLRestClientURI; const aUserName, aPassword: RawUTF8;
      aPassworKind: TSQLRestServerAuthenticationClientSetUserPassword=passClear): boolean; override;
  end;
  
  TSQLAuthGroupAD = class(TSQLAuthGroup)
    class procedure InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
      Options: TSQLInitializeTableOptions); override;
  end;


{ TSQLRestServerAuthenticationAD }

function TSQLRestServerAuthenticationAD.Auth(Ctxt: TSQLRestServerURIContext): boolean;
var aUserName, aPassWord, aClientNonce, aData: RawUTF8;
    sData, sLen: string;
    User: TSQLAuthUser;
begin
  result := true;
  if AuthSessionRelease(Ctxt) then
    exit;
  aUserName := Ctxt.InputUTF8OrVoid['UserName'];
  aClientNonce := Ctxt.InputUTF8OrVoid['ClientNonce'];
  if (aUserName<>'') and (aClientNonce<>'') then begin
    User := GetUser(Ctxt,aUserName);
    if User=nil then begin
      User := GetUser(Ctxt,'*');
      if User<>nil then begin
        User.LogonName := aUserName;
        User.DisplayName := aUserName;
      end;
    end;
    if User<>nil then
    try
      User.PasswordHashHexa := '';
      aPassWord := Ctxt.InputUTF8OrVoid['Password'];
      aData := Ctxt.InputUTF8OrVoid['Data'];
      aData := AESSHA256(aData, TSQLAUTHUSER_SALT+aUserName,false);
      sData := UTF8ToString(aData);
      sLen := sData.Substring(3, 3);
      aData := StringToUTF8(sData.Substring(6, StrToInt(sLen)));
      if not CheckPassword(Ctxt,aClientNonce,aUserName,aPassWord,aData) then
        exit;
      // now client is authenticated -> create a session
      SessionCreate(Ctxt,User);
    finally
      User.Free;
    end;
  end else
    if aUserName<>'' then
      // only UserName=... -> return hexadecimal nonce content valid for 5 minutes
      Ctxt.Results([Nonce(false)]) else
      // parameters does not match any expected layout
      result := false;
end;

function ADCheckPassword(const sUserName, sDomainName, sPassword: PChar): Boolean;
var
  hToken: THandle;
begin
  Result := LogonUser(sUserName, sDomainName, sPassword,
              9{LOGON_TYPE_NEW_CREDENTIALS}, LOGON32_PROVIDER_WINNT50, hToken);
  if Result then
    CloseHandle(hToken);
end;

function TSQLRestServerAuthenticationAD.CheckPassword(Ctxt: TSQLRestServerURIContext;
  const aClientNonce, aUserName, aPassWord, aData: RawUTF8): boolean;
var aSalt: RawUTF8;
    sUserName, sDomainName: string;
    N: Integer;
begin
  aSalt := TSQLAUTHUSER_SALT+aClientNonce+aUserName;
  result := (aPassWord=SHA256(fServer.Model.Root+Nonce(false)+aSalt)) or
            // if current nonce failed, tries with previous 5 minutes nonce
            (aPassWord=SHA256(fServer.Model.Root+Nonce(true)+aSalt));
  if result then begin
    sDomainName := string(aUserName);
    N := sDomainName.IndexOf('\');
    if N > -1 then begin
      sUserName := sDomainName.Substring(0, N);
      sDomainName := sDomainName.Substring(N + 1, sDomainName.Length);
      result := ADCheckPassword(PChar(sUserName), PChar(sDomainName), PChar(UTF8ToString(aPassWord)));
    end
    else
      result := false;
  end;
end;

class function TSQLRestServerAuthenticationAD.ClientComputeSessionKey(Sender: TSQLRestClientURI;
  User: TSQLAuthUser): RawUTF8;
var aServerNonce, aClientNonce: RawUTF8;
begin
  result := '';
  if User.LogonName='' then
    exit;
  aServerNonce := Sender.CallBackGetResult('Auth',['UserName',User.LogonName]);
  if aServerNonce='' then
    exit;
  aClientNonce := Nonce(false);
  result := Sender.CallBackGetResult('Auth',['UserName',User.LogonName,'Password',
     Sha256(Sender.Model.Root+aServerNonce+TSQLAUTHUSER_SALT+aClientNonce+User.LogonName),
     'ClientNonce',aClientNonce,'Data',User.Data]);
end;

class function TSQLRestServerAuthenticationAD.ClientSetUser(Sender: TSQLRestClientURI; const aUserName,
  aPassword: RawUTF8; aPassworKind: TSQLRestServerAuthenticationClientSetUserPassword=passClear): boolean;
var U: TSQLAuthUser;
begin
  result := false;
  if Sender=nil then
    exit;
  try
    Sender.SessionClose;
    U := TSQLAuthUser.Create;
    try
      U.LogonName := trim(aUserName);
      U.DisplayName := U.LogonName;
      U.PasswordHashHexa := '';
      // Encrypt password AesSha256(LengthOfPassword(00N)+aPassword+Sha256(Random(99999999)))
      U.Data := AESSHA256(StringToUTF8(Format('%.3d%.3d', [Random(999), Length(aPassword)]))+
                          aPassword+Sha256(StringToUTF8(Format('%.8d', [Random(99999999)]))),
                  TSQLAUTHUSER_SALT+U.LogonName, True);
      result := Sender.SessionCreate(self,U,ClientComputeSessionKey(Sender,U));
    finally
      U.Free;
    end;
  finally
    if Assigned(Sender.OnSetUser) then
      Sender.OnSetUser(Sender); // always notify of user change, even if failed
  end;
end;


{ TSQLAuthGroupAD }

class procedure TSQLAuthGroupAD.InitializeTable(Server: TSQLRestServer; const FieldName: RawUTF8;
  Options: TSQLInitializeTableOptions);
var G: TSQLAuthGroup;
    U: TSQLAuthUser;
    UserID: PtrInt;
begin
  inherited InitializeTable(Server, FieldName, Options);
  if (Server<>nil) and (FieldName='') then
    if Server.HandleAuthentication then begin
      // create default AD user '*' - settings for all users
      G := TSQLAuthGroupAD.Create(Server,'Ident=?',['User']);
      try
        UserId := G.ID;
      finally
        G.Free;
      end;
      if UserId>0 then begin
        U := Server.fSQLAuthUserClass.Create;
        try
          U.LogonName := '*';
          U.PasswordHashHexa := '';
          U.DisplayName := U.LogonName;
          U.GroupRights := TSQLAuthGroup(UserID);
          Server.Add(U,true);
        finally
          U.Free;
        end;
      end;
    end;
end;

Last edited by EgorovAlex (2015-03-06 12:47:53)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

Great!
Thanks a lot for sharing!

I've added a saoHandleUnknownLogonAsStar new option for TSQLRestServerAuthentication so that this TSQLAuthUser.LogonName='*' feature could be enabled for all means of authentication.
This is disabled by default, for obvious security reasons.

I did not understand what your local aData parameter was all about...
So I just disabled it.
The same for the "client nonce" with was not needed in your case.

One issue with your implementation is that the password is transmitted as plain text...
So I've tried to add simple encryption.
Not very secured yet, but better than nothing!

See http://synopse.info/fossil/info/f1e7198954

I did not test it yet (and probably won't be before Monday), so any feedback is welcome!

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Your variant has more convenient format, but this is a bad idea, I think, to invoke internal function CheckPassword twice, on some system this can have some problems with locking of account. This is reason that was used different params to send nonce and password separately

Edit: In my variant the Password parameter was used to compare Nonce,
Data parameter (which was encrypted, but too easy) used to send password

Edit2:
40906 line:
if aPassworKind<>passClear then
    raise ESecurityException.CreateUTF8('%.ClientSetUser() expects passClear',[self]);
  result := inherited ClientSetUser(Sender,aUserName,aPassword,passHashed);

passHashed should be changed to passClear, i think?
otherwise we will have unreadable hash of password which impossible to check

Last edited by EgorovAlex (2015-03-06 19:34:51)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

I will find an alternative for the password.
But it should never lock the account otherwise an DOS attack could be very easy to implement.

For the password it should be passed as clear by the  user but as already hashed before the check.

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Hello again,

please change your code in mORMot.pas to this improved functions, current implementation is unusable:

function TSQLRestServerAuthenticationActiveDirectory.Auth(Ctxt: TSQLRestServerURIContext): boolean;
function CheckPassword(const UserName,Password: RawUTF8): Boolean;
var Domain,Login: RawUTF8;
    hToken: THandle;
begin
  split(UserName,'\',Domain,Login);
  result := LogonUser(pointer(UTF8ToString(Login)),pointer(UTF8ToString(Domain)),
    pointer(UTF8ToString(Password)),9,LOGON32_PROVIDER_WINNT50,hToken);
  if result then
    CloseHandle(hToken);
end;
var aUserName, aHashedPassWord, aPassword, aSalt: RawUTF8;
    User: TSQLAuthUser;
begin
  result := true;
  if AuthSessionRelease(Ctxt) then
    exit;
  aUserName := Ctxt.InputUTF8OrVoid['UserName'];
  aHashedPassWord := Base64ToBin(Ctxt.InputUTF8OrVoid['Password']);
  if (aUserName<>'') and (aHashedPassWord<>'') then begin
    User := GetUser(Ctxt,aUserName);
    if User<>nil then
    try
      User.PasswordHashHexa := ''; // not needed, especially if from LogonName='*'
      aPassword := TAESCFB.SimpleEncrypt(aHashedPassWord,Nonce(false)+AD_SALT,false);
      split(aPassword,'\',aSalt,aPassword);
      if aSalt<>AD_SALT then begin
        aPassword := TAESCFB.SimpleEncrypt(aHashedPassWord,Nonce(true)+AD_SALT,false);
        split(aPassword,'\',aSalt,aPassword);
        if aSalt<>AD_SALT then
          exit; // current and previous server nonce did not success
      end;
      if not CheckPassword(aUserName,aPassWord) then
        exit; // Active Directory password incorrect
      // now client is authenticated -> create a session
      SessionCreate(Ctxt,User);
    finally
      User.Free;
    end;
  end else
    if aUserName<>'' then
      // only UserName=... -> return hexadecimal nonce content valid for 5 minutes
      Ctxt.Results([Nonce(false)]) else
      // parameters does not match any expected layout
      result := false;
end;

class function TSQLRestServerAuthenticationActiveDirectory.ClientComputeSessionKey(Sender: TSQLRestClientURI;
  User: TSQLAuthUser): RawUTF8;
var aServerNonce: RawUTF8;
begin
  result := '';
  if User.LogonName='' then
    exit;
  aServerNonce := Sender.CallBackGetResult('Auth',['UserName',User.LogonName]);
  if aServerNonce='' then
    exit;
  result := Sender.CallBackGetResult('Auth',['UserName',User.LogonName,
    'Password',BinToBase64(TAESCFB.SimpleEncrypt(
    AD_SALT+'\'+User.PasswordHashHexa,aServerNonce+AD_SALT,true))]);
end;

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Also I can prepare sample server code which can be included in your 14 sample with Active Directory (and local computer) authentication, I think this can be useful for many customers, do you need this?

Last edited by EgorovAlex (2015-03-09 20:37:54)

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

The http://synopse.info/fossil/info/6a1f5ee118 version contains your fix.
Including the new option storing the CFB cyphering IV at the beginning of the transmitted content, as AES best practice dictates.

Yes, any dedicated sample is welcome!

Thanks for sharing!

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Files for example 14 with Active Directory authentication below
(this is impossible to attach files?)

Project14ClientMain.pas
Added authorization line:     
3:   TSQLRestServerAuthenticationActiveDirectory.ClientSetUser(Client,'Computer\User','Password');

unit Project14ClientMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  SynCommons, mORMot, mORMotHttpClient,
  Project14Interface;

type
  TForm1 = class(TForm)
    edtA: TEdit;
    edtB: TEdit;
    lblA: TLabel;
    lblB: TLabel;
    btnCall: TButton;
    btnCancel: TButton;
    lblResult: TLabel;
    ComboProtocol: TComboBox;
    procedure btnCancelClick(Sender: TObject);
    procedure btnCallClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ComboProtocolChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Model: TSQLModel;
    Client: TSQLRestClientURI;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{$R Vista.res}

procedure TForm1.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.btnCallClick(Sender: TObject);
var a,b: integer;
    err: integer;
    I: ICalculator;
begin
  val(edtA.Text,a,err);
  if err<>0 then begin
    edtA.SetFocus;
    exit;
  end;
  val(edtB.Text,b,err);
  if err<>0 then begin
    edtB.SetFocus;
    exit;
  end;
  if Client=nil then begin
    if Model=nil then
      Model := TSQLModel.Create([],ROOT_NAME);
    case ComboProtocol.ItemIndex of
    0,2,3: Client := TSQLHttpClient.Create('localhost','888',Model);
    1: Client := TSQLRestClientURINamedPipe.Create(Model,APPLICATION_NAME);
    else exit;
    end;
    if not Client.ServerTimeStampSynchronize then begin
      ShowMessage(UTF8ToString(Client.LastErrorMessage));
      exit;
    end;
    case ComboProtocol.ItemIndex of
    2:   TSQLRestServerAuthenticationNone.ClientSetUser(Client,'User','');
	     // Here possible to use 'ComputerName\User' or 'DomainName\User'
    3:   TSQLRestServerAuthenticationActiveDirectory.ClientSetUser(Client,'Computer\User','Password');
    else Client.SetUser('User','synopse');
    end;
    Client.ServiceDefine([ICalculator],sicShared);
  end;
  if Client.Services['Calculator'].Get(I) then
    lblResult.Caption := IntToStr(I.Add(a,b));
end;

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

procedure TForm1.ComboProtocolChange(Sender: TObject);
begin
  FreeAndNil(Client);
end;

end.

Project14ClientMain.dfm
Added 'Active Directory HTTP / TCP-IP' dropdown item to TComboBox

object Form1: TForm1
  Left = 334
  Top = 330
  Caption = 'Form1'
  ClientHeight = 242
  ClientWidth = 306
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 16
  object lblA: TLabel
    Left = 56
    Top = 50
    Width = 17
    Height = 16
    Caption = 'A='
  end
  object lblB: TLabel
    Left = 56
    Top = 98
    Width = 16
    Height = 16
    Caption = 'B='
  end
  object lblResult: TLabel
    Left = 76
    Top = 200
    Width = 184
    Height = 16
    Caption = 'Enter numbers, then Call Server'
  end
  object edtA: TEdit
    Left = 80
    Top = 48
    Width = 153
    Height = 24
    TabOrder = 0
  end
  object edtB: TEdit
    Left = 80
    Top = 96
    Width = 153
    Height = 24
    TabOrder = 1
  end
  object btnCall: TButton
    Left = 56
    Top = 152
    Width = 97
    Height = 25
    Caption = 'Call Server'
    TabOrder = 2
    OnClick = btnCallClick
  end
  object btnCancel: TButton
    Left = 168
    Top = 152
    Width = 97
    Height = 25
    Caption = 'Quit'
    TabOrder = 3
    OnClick = btnCancelClick
  end
  object ComboProtocol: TComboBox
    Left = 80
    Top = 16
    Width = 153
    Height = 24
    Style = csDropDownList
    TabOrder = 4
    OnChange = ComboProtocolChange
    Items.Strings = (
      'HTTP / TCP-IP'
      'Named Pipe'
      'Weak HTTP / TCP-IP'
      'Active Directory HTTP / TCP-IP')
  end
end

Project14ServerHttpActiveDirectory.dpr

/// this server will use Active Directory authentication with TSQLRestServerFullMemory over HTTP
// demonstrated how to change default passwords for default users
program Project14ServerHttpWeak;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  SynCommons,
  SynLog,
  mORMot,
  mORMotSQLite3,
  mORMotHttpServer,
  Project14Interface;

type
  TServiceCalculator = class(TInterfacedObject, ICalculator)
  public
    function Add(n1,n2: integer): integer;
  end;

function TServiceCalculator.Add(n1, n2: integer): integer;
begin
  result := n1+n2;
end;

procedure RegisterAuthenticationActiveDirectory(Server: TSQLRestServer; EnableDefaultUser: Boolean);

  procedure ChangeDefaultPassword(LogonName, Password: RawUTF8);
  var
    U: TSQLAuthUser;
  begin
    U := Server.SQLAuthUserClass.Create(Server, 'LogonName=?', [LogonName]);
    try
      if U.ID > 0 then begin
        U.PasswordPlain := Password;
        Server.Update(U);
      end;
    finally
      U.Free;
    end;
  end;

var
  Auth: TSQLRestServerAuthentication;
  G: TSQLAuthGroup;
  U: TSQLAuthUser;
  UserID: PtrInt;
begin
  Auth := Server.AuthenticationRegister(TSQLRestServerAuthenticationActiveDirectory);
  Server.CreateMissingTables;
  // Change default passwords
  ChangeDefaultPassword('Admin', 'AdminPass');
  ChangeDefaultPassword('Supervisor', 'SupervisorPass');
  ChangeDefaultPassword('User', 'UserPass');
  if EnableDefaultUser then
    // Enable work with user '*'
    Auth.Options := Auth.Options + [saoHandleUnknownLogonAsStar];
    // Get ID of group with User access rights
    G := Server.SQLAuthGroupClass.Create(Server, 'Ident=?', ['User']);
    try
      UserId := G.ID;
    finally
      G.Free;
    end;
    if UserId > 0 then begin
      // Create default Active Directory user '*' - settings for all authenticated users
      U := Server.SQLAuthUserClass.Create(Server, 'LogonName=?', ['*']);
      try
        if U.ID = 0 then begin
          U.LogonName        := '*';
          U.DisplayName      := U.LogonName;
          U.PasswordHashHexa := '';
          U.GroupRights      := TSQLAuthGroup(UserID);
          Server.Add(U,true);
        end;
      finally
        U.Free;
      end;
    end;
end;

var
  aModel: TSQLModel;
  aServer: TSQLRestServer;
  aHTTPServer: TSQLHttpServer;
begin
  // define the log level
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    EchoToConsole := LOG_VERBOSE; // log all events to the console
  end;
  // create a Data Model (including TSQLAuthGroup,TSQLAuthUser here)
  aModel := TSQLModel.Create([TSQLAuthGroup,TSQLAuthUser],ROOT_NAME);
  try
    // initialize a TObjectList-based database engine
    aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,false);
    try
	  // register TSQLRestServerAuthenticationActiveDirectory
	  // enable default user '*' for authenticated users
      RegisterAuthenticationActiveDirectory(aServer,true);
      // register our ICalculator service on the server side
      aServer.ServiceDefine(TServiceCalculator,[ICalculator],sicShared);
      // launch the HTTP server
      aHTTPServer := TSQLHttpServer.Create(PORT_NAME,[aServer],'+',useHttpApiRegisteringURI);
      try
        aHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to work
        writeln(#10'Background server is running.'#10);
        writeln('Press [Enter] to close the server.'#10);
        readln;
      finally
        aHTTPServer.Free;
      end;
    finally
      aServer.Free;
    end;
  finally
    aModel.Free;
  end;
end.

DigDiver

Member

Registered: 2013-04-29

Posts: 137

Re: Restrict connections count

There is the same problem with TSQLRestServerAuthenticationActiveDirectory.Auth

function TSQLRestServerAuthenticationActiveDirectory.Auth(Ctxt: TSQLRestServerURIContext): boolean;
..
  result := LogonUser(pointer(UTF8ToString(Login)),pointer(UTF8ToString(Domain)),
    pointer(UTF8ToString(Password)),9 ,LOGON32_PROVIDER_WINNT50,hToken);

When I try with a different  logon type (LOGON32_LOGON_NETWORK, LOGON32_LOGON_INTERACTIVE, LOGON32_LOGON_SERVICE) the LogonUser to always returns false.

Does anybody have success to implement TSQLRestServerAuthenticationActiveDirectory authentication?

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Which Windows version do you use for test?

9 this is LOGON32_LOGON_NEW_CREDENTIALS works on all my test computers

And this is works even to check domain password from non domain computer

Last edited by EgorovAlex (2015-03-10 10:34:30)

DigDiver

Member

Registered: 2013-04-29

Posts: 137

Re: Restrict connections count

Windows 8.1 - client, Server 2012 as server
The LogonUser function is called with LogonType = 9 (LOGON32_LOGON_NEW_CREDENTIALS). LOGON32_LOGON_NEW_CREDENTIALS causes LogonUser to always return true,  even wrong credentials is provide.

Last edited by DigDiver (2015-03-10 11:52:23)

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

DigDiver, you are completely right! Unfortunately this function always return true, this is a bad news.
Good news, that I have correct function to check password, but I don't know where in mORMot is a right place
to put this function (this function used in my project for many years without any problems, but this is can't check domain password from non domain computer, I think this is not a big restriction):

function ADCheckPassword(const sUserName, sDomainName, sPassword: string): Boolean;
const
  SEC_WINNT_AUTH_IDENTITY_ANSI       = $01;
  SEC_WINNT_AUTH_IDENTITY_UNICODE    = $02;
  SEC_WINNT_AUTH_IDENTITY_MARSHALLED = $04;     // all data is in one buffer
  SEC_WINNT_AUTH_IDENTITY_ONLY       = $08;     // these credentials are for identity only - no PAC needed
  SECPKG_CRED_INBOUND          = $00000001;
  SECPKG_CRED_OUTBOUND         = $00000002;
  SECPKG_CRED_BOTH             = $00000003;
  SECPKG_CRED_DEFAULT          = $00000004;
  SECPKG_CRED_RESERVED         = $F0000000;

  SECBUFFER_VERSION            = 0;

  SECBUFFER_EMPTY              = 0;  // Undefined, replaced by provider
  SECBUFFER_DATA               = 1;  // Packet data
  SECBUFFER_TOKEN              = 2;  // Security token
  SECBUFFER_PKG_PARAMS         = 3;  // Package specific parameters
  SECBUFFER_MISSING            = 4;  // Missing Data indicator
  SECBUFFER_EXTRA              = 5;  // Extra data
  SECBUFFER_STREAM_TRAILER     = 6;  // Security Trailer
  SECBUFFER_STREAM_HEADER      = 7;  // Security Header
  SECBUFFER_NEGOTIATION_INFO   = 8;  // Hints from the negotiation pkg
  SECBUFFER_PADDING            = 9;  // non-data padding
  SECBUFFER_STREAM             = 10; // whole encrypted message

  SECBUFFER_ATTRMASK           = $F0000000;
  SECBUFFER_READONLY           = $80000000;  // Buffer is read-only
  SECBUFFER_RESERVED           = $40000000;

  SECURITY_NATIVE_DREP         = $00000010;
  SECURITY_NETWORK_DREP        = $00000000;

  SEC_I_CONTINUE_NEEDED        = $00090312;
  SEC_I_COMPLETE_NEEDED        = $00090313;
  SEC_I_COMPLETE_AND_CONTINUE  = $00090314;

type
  TSecWinntAuthIdentity = packed record
    User : PChar;
    UserLength : DWORD;
    Domain : PChar;
    DomainLength : DWORD;
    Password : PChar;
    PasswordLength : DWORD;
    Flags : DWORD
  end;
  PSecWinntAuthIdentity = ^TSecWinntAuthIdentity;

  TSecHandle = packed record
    dwLower : DWORD;
    dwUpper : DWORD
  end;
  PSecHandle = ^TSecHandle;

  TSecBuffer = packed record
    cbBuffer : DWORD;
    BufferType : DWORD;          // Type of the buffer (below)
    pvBuffer : pointer;
  end;
  PSecBuffer = ^TSecBuffer;

  TSecBufferDesc = packed record
    ulVersion,
    cBuffers : DWORD;            // Number of buffers
    pBuffers : PSecBuffer
  end;
  PSecBufferDesc = ^TSecBufferDesc;

  TCredHandle = TSecHandle;
  PCredHandle = PSecHandle;

  TCtxtHandle = TSecHandle;
  PCtxtHandle = PSecHandle;

  TAuthSeq = packed record
    _fNewConversation : BOOL;
    _hcred : TCredHandle;
    _fHaveCredHandle : BOOL;
    _fHaveCtxtHandle : BOOL;
    _hctxt : TSecHandle;
  end;
  PAuthSeq = ^TAuthSeq;

  PNode = ^TNode;
  TNode = record
    dwKey : DWORD;
    pData : pointer;
    pNext : PNode
  end;

  TSecPkgInfo = record
    fCapabilities : DWORD;        // Capability bitmask
    wVersion : WORD;              // Version of driver
    wRPCID : WORD;                // ID for RPC Runtime
    cbMaxToken : DWORD;           // Size of authentication token (max)   Name : PChar;
    Comment : PChar;              // Comment
  end;
  PSecPkgInfo = ^TSecPkgInfo;

  TSecurityStatus = LongInt;

  ENUMERATE_SECURITY_PACKAGES_FN  = function(var cPackages: DWORD; var PackageInfo: PSecPkgInfo): TSecurityStatus; stdcall;
  QUERY_SECURITY_PACKAGE_INFO_FN  = function(packageName: PChar; var info: PSecPkgInfo): TSecurityStatus; stdcall;
  QUERY_CREDENTIALS_ATTRIBUTES_FN = function(phCredential: pCredHandle; ulAttribute: DWORD; buffer: pointer): TSecurityStatus; stdcall;
  EXPORT_SECURITY_CONTEXT_FN      = function(hContext: pCtxtHandle; flags: DWORD; pPackedContext: PSecBuffer; var token : pointer): TSecurityStatus; stdcall;
  SEC_GET_KEY_FN                  = procedure(Arg, Principal: pointer; KeyVer: DWORD; var Key: pointer; var status: TSecurityStatus); stdcall;
  ACQUIRE_CREDENTIALS_HANDLE_FN   = function(pszPrincipal: PChar; pszPackage: PChar; fCredentialUse: DWORD; pvLogonID: pointer; pAuthData: pointer; pGetKeyFn: SEC_GET_KEY_FN;
                                      pvGetKeyArgument: pointer; var phCredential: TCredHandle; var ptsExpiry: TTimeStamp): TSecurityStatus; stdcall;
  FREE_CREDENTIALS_HANDLE_FN      = function(credHandle: PCredHandle): TSecurityStatus; stdcall;
  INITIALIZE_SECURITY_CONTEXT_FN  = function(phCredential: PCredHandle; phContent: PCtxtHandle; pszTargetName: PChar; fContextReq, Reserved1, TargetDataRep: DWORD; pInput: PSecBufferDesc;
                                      Reserved2: DWORD; phNewContext: PCtxtHandle; pOutput: PSecBufferDesc; var pfContextAttr: DWORD; var ptsExpiry: TTimeStamp): TSecurityStatus; stdcall;
  ACCEPT_SECURITY_CONTEXT_FN      = function (phCredential: PCredHandle; phContext: PCtxtHandle; pInput: PSecBufferDesc; fContextReq, TargetDataRep: DWORD;
                                      phNewContext: PCtxtHandle; pOutput: PSecBufferDesc; var pfContextAttr: DWORD; var ptsExpiry: TTimeStamp): TSecurityStatus; stdcall;
  COMPLETE_AUTH_TOKEN_FN          = function (phContext: PCtxtHandle; pToken: PSecBufferDesc): TSecurityStatus; stdcall;
  DELETE_SECURITY_CONTEXT_FN      = function (phContext: PCtxtHandle): TSecurityStatus; stdcall;
  APPLY_CONTROL_TOKEN_FN          = function (phContext: PCtxtHandle; pInput: PSecBufferDesc): TSecurityStatus; stdcall;
  QUERY_CONTEXT_ATTRIBUTES_FN     = function (phContext: PCtxtHandle; alAttribute: DWORD; pBuffer: pointer): TSecurityStatus; stdcall;
  IMPERSONATE_SECURITY_CONTEXT_FN = function (phContext: PCtxtHandle): TSecurityStatus; stdcall;
  REVERT_SECURITY_CONTEXT_FN      = function (phContext: PCtxtHandle): TSecurityStatus; stdcall;
  MAKE_SIGNATURE_FN               = function (phContext: PCtxtHandle; fQOP: DWORD; pMessage: PSecBufferDesc; MessageSeqNo: DWORD): TSecurityStatus; stdcall;
  VERIFY_SIGNATURE_FN             = function (phContext: PCtxtHandle; pMessage: PSecBufferDesc; MessageSeqNo: DWORD; var fQOP: DWORD): TSecurityStatus; stdcall;
  FREE_CONTEXT_BUFFER_FN          = function (contextBuffer: pointer): TSecurityStatus; stdcall;
  IMPORT_SECURITY_CONTEXT_FN      = function (pszPackage: PChar; pPackedContext: PSecBuffer; Token: pointer; phContext: PCtxtHandle): TSecurityStatus; stdcall;
  ADD_CREDENTIALS_FN              = function (hCredentials: PCredHandle; pszPrincipal, pszPackage: PChar; fCredentialUse: DWORD; pAuthData: pointer;
                                      pGetKeyFn: SEC_GET_KEY_FN; pvGetKeyArgument: pointer; var ptsExpiry: TTimeStamp): TSecurityStatus; stdcall;
  QUERY_SECURITY_CONTEXT_TOKEN_FN = function (phContext: PCtxtHandle; var token: pointer): TSecurityStatus; stdcall;
  ENCRYPT_MESSAGE_FN              = function (phContext: PCtxtHandle; fQOP: DWORD; pMessage: PSecBufferDesc; MessageSeqNo: DWORD): TSecurityStatus; stdcall;
  DECRYPT_MESSAGE_FN              = function (phContext: PCtxtHandle; pMessage: PSecBufferDesc; MessageSeqNo: DWORD; fQOP: DWORD): TSecurityStatus; stdcall;

  TSecurityFunctionTable = record
    dwVersion : LongInt;
    EnumerateSecurityPackages  : ENUMERATE_SECURITY_PACKAGES_FN;
    QueryCredentialsAttributes : QUERY_CREDENTIALS_ATTRIBUTES_FN;
    AcquireCredentialsHandle   : ACQUIRE_CREDENTIALS_HANDLE_FN;
    FreeCredentialHandle       : FREE_CREDENTIALS_HANDLE_FN;
    Reserved2                  : FARPROC;
    InitializeSecurityContext  : INITIALIZE_SECURITY_CONTEXT_FN;
    AcceptSecurityContext      : ACCEPT_SECURITY_CONTEXT_FN;
    CompleteAuthToken          : COMPLETE_AUTH_TOKEN_FN;
    DeleteSecurityContext      : DELETE_SECURITY_CONTEXT_FN;
    ApplyControlToken          : APPLY_CONTROL_TOKEN_FN;
    QueryContextAttributes     : QUERY_CONTEXT_ATTRIBUTES_FN;
    ImpersonateSecurityContext : IMPERSONATE_SECURITY_CONTEXT_FN;
    RevertSecurityContext      : REVERT_SECURITY_CONTEXT_FN;
    MakeSignature              : MAKE_SIGNATURE_FN;
    VerifySignature            : VERIFY_SIGNATURE_FN;
    FreeContextBuffer          : FREE_CONTEXT_BUFFER_FN;
    QuerySecurityPackageInfo   : QUERY_SECURITY_PACKAGE_INFO_FN;
    Reserved3                  : FARPROC;
    Reserved4                  : FARPROC;
    ExportSecurityContext      : EXPORT_SECURITY_CONTEXT_FN;
    ImportSecurityContext      : IMPORT_SECURITY_CONTEXT_FN;
    AddCredentials             : ADD_CREDENTIALS_FN;
    Reserved8                  : FARPROC;
    QuerySecurityContextToken  : QUERY_SECURITY_CONTEXT_TOKEN_FN;
    EncryptMessage             : ENCRYPT_MESSAGE_FN;
    DecryptMessage             : DECRYPT_MESSAGE_FN;
  end;
  PSecurityFunctionTable = ^TSecurityFunctionTable;

  var
    Head: TNode;

  function GetEntry(dwKey: DWORD; var pData: pointer): boolean;
  var
    pCurrent: PNode;
  begin
    result := False;
    pCurrent := Head.pNext;
    while Assigned (pCurrent) do
    begin
      if pCurrent^.dwKey = dwKey then
      begin
        pData := pCurrent^.pData;
        result := True;
        break
      end;
      pCurrent := pCurrent^.pNext
    end
  end;

  function AddEntry(dwKey: DWORD; pData: pointer): boolean;
  var
    pTemp: PNode;
  begin
    GetMem(pTemp, sizeof(TNode));
    if Assigned(pTemp) then
    begin
      pTemp^.dwKey := dwKey;
      pTemp^.pData := pData;
      pTemp^.pNext := Head.pNext;
      Head.pNext := pTemp;
      result := True
    end
    else
      result := False
  end;

  function DeleteEntry(dwKey: DWORD; var ppData: pointer): boolean;
  var
    pCurrent, pTemp: PNode;
  begin
    result := False;
    pTemp := @head;
    pCurrent := Head.pNext;
    while pCurrent <> Nil do begin
      if dwKey = pCurrent^.dwKey then begin
        pTemp^.pNext := pCurrent^.pNext;
        ppData := pCurrent^.pData;
        FreeMem (pCurrent);
        result := True;
        break
      end
      else begin
        pTemp := pCurrent;
        pCurrent := pCurrent^.pNext
      end
    end
  end;

  function InitSession(dwKey: DWORD): boolean;
  var
    pAS: PAuthSeq;
  begin
    result := False;
    GetMem(pAS, sizeof(TAuthSeq));
    if Assigned(pAS) then
    try
      pAS^._fNewConversation := TRUE;
      pAS^._fHaveCredHandle := FALSE;
      pAS^._fHaveCtxtHandle := FALSE;
      if not AddEntry (dwKey, pAS) then
        FreeMem (pAS)
      else
        result := True
    except
      FreeMem (pAS);
      raise
    end
  end;

  function InitPackage(var cbMaxMessage: DWORD; var funcs:PSecurityFunctionTable): THandle;
  type
    INIT_SECURITY_ENTRYPOINT_FN = function: PSecurityFunctionTable;
  var
    pInit: INIT_SECURITY_ENTRYPOINT_FN;
    ss: TSecurityStatus;
    pkgInfo: PSecPkgInfo;
  begin
    result := LoadLibrary('security.dll');  // *** Secur32.dll for Windows 95
    if result <> 0 then
    try
      pInit := GetProcAddress(result, 'InitSecurityInterfaceW');
      if not Assigned(pInit) then
        raise Exception.CreateFmt('Couldn''t get sec init routine: %d', [GetLastError]);
      funcs := pInit;
      if not Assigned(funcs) then
        raise Exception.Create('Couldn''t init package');
      ss := funcs^.QuerySecurityPackageInfo('NTLM', pkgInfo);
      if ss < 0 then
        raise Exception.CreateFmt('Couldn''t query package info for NTLM, error %d\n', [ss]);
      cbMaxMessage := pkgInfo^.cbMaxToken;
      funcs^.FreeContextBuffer(pkgInfo)
    except
      if result <> 0 then
        FreeLibrary(result);
      raise
    end
  end;

  function GenClientContext(funcs: PSecurityFunctionTable; dwKey: DWORD; Auth: PSecWINNTAuthIdentity;
    pIn: PBYTE; cbIn: DWORD; pOut: PBYTE; var cbOut: DWORD; var fDone: boolean): boolean;
  var
    ss: TSecurityStatus;
    lifeTime: TTimeStamp;
    OutBuffDesc: TSecBufferDesc;
    OutSecBuff: TSecBuffer;
    InBuffDesc: TSecBufferDesc;
    InSecBuff: TSecBuffer;
    ContextAttributes: DWORD;
    pAS: PAuthSeq;
    phctxt: PCtxtHandle;
    pBuffDesc: PSecBufferDesc;
  begin
    result := False;
    if GetEntry(dwKey, pointer (pAS)) then
    try
      if pAS^._fNewConversation then begin
        ss := funcs^.AcquireCredentialsHandle(nil{principal}, 'NTLM', SECPKG_CRED_OUTBOUND, nil{LOGON id},
                Auth{auth data}, nil{get key fn}, nil{get key arg}, pAS^._hcred, Lifetime);
        if ss < 0 then
          raise Exception.CreateFmt ('AquireCredentials failed %d', [ss]);
        pAS^._fHaveCredHandle := TRUE
      end;

      OutBuffDesc.ulVersion := 0;
      OutBuffDesc.cBuffers := 1;
      OutBuffDesc.pBuffers := @OutSecBuff;

      OutSecBuff.cbBuffer := cbOut;
      OutSecBuff.BufferType := SECBUFFER_TOKEN;
      OutSecBuff.pvBuffer := pOut;

      // prepare input buffer
      if not pAS^._fNewConversation then begin
        InBuffDesc.ulVersion := 0;
        InBuffDesc.cBuffers := 1;
        InBuffDesc.pBuffers := @InSecBuff;

        InSecBuff.cbBuffer := cbIn;
        InSecBuff.BufferType := SECBUFFER_TOKEN;
        InSecBuff.pvBuffer := pIn
      end;

      if pAS^._fNewConversation then begin
        pBuffDesc := nil;
        phctxt := nil
      end
      else begin
        phctxt := @pAS^._hctxt;
        pBuffDesc := @InBuffDesc
      end;

      ss := funcs^.InitializeSecurityContext(@pAS^._hcred, phctxt, 'AuthSamp', 0{context requirements},
              0{reserved1}, SECURITY_NATIVE_DREP, pBuffDesc, 0{reserved2}, @pAS^._hctxt, @OutBuffDesc,
              ContextAttributes, Lifetime);
      if ss < 0 then
        raise Exception.CreateFmt ('Init context failed: %d', [ss]);

      pAS^._fHaveCtxtHandle := TRUE;

      if (ss = SEC_I_COMPLETE_NEEDED) or (ss = SEC_I_COMPLETE_AND_CONTINUE) then begin
        if Assigned (funcs^.CompleteAuthToken) then begin
          ss := funcs^.CompleteAuthToken (@pAS^._hctxt, @OutBuffDesc);
          if ss < 0 then
            raise Exception.CreateFmt ('Complete failed: %d', [ss])
        end;
      end;

      cbOut := OutSecBuff.cbBuffer;

      if pAS^._fNewConversation then
        pAS^._fNewConversation := FALSE;

      fDone := (ss <> SEC_I_CONTINUE_NEEDED) and (ss <> SEC_I_COMPLETE_AND_CONTINUE);

      result := True
    except
    end
  end;

  function GenServerContext(funcs: PSecurityFunctionTable; dwKey: DWORD; pIn: PByte; cbIn: DWORD; pOut: PByte;
    var cbOut: DWORD; var fDone: boolean) : boolean;
  var
    ss: TSecurityStatus;
    Lifetime:  TTimeStamp;
    OutBuffDesc, InBuffDesc: TSecBufferDesc;
    InSecBuff, OutSecBuff: TSecBuffer;
    ContextAttributes: DWORD;
    pAS: PAuthSeq;
    phctxt: PCtxtHandle;
  begin
    result := False;
    if GetEntry(dwKey, pointer (pAS)) then
    try
      if pAS^._fNewConversation then begin
        ss := funcs^.AcquireCredentialsHandle(nil{principal}, 'NTLM', SECPKG_CRED_INBOUND, nil{LOGON id},
                nil{auth data}, nil{get key fn}, nil{get key arg}, pAS^._hcred, Lifetime);
        if ss < 0 then
          raise Exception.CreateFmt ('AcquireCreds failed %d', [ss]);
        pAS^._fHaveCredHandle := TRUE
      end;

      // prepare output buffer
      OutBuffDesc.ulVersion := 0;
      OutBuffDesc.cBuffers := 1;
      OutBuffDesc.pBuffers := @OutSecBuff;

      OutSecBuff.cbBuffer := cbOut;
      OutSecBuff.BufferType := SECBUFFER_TOKEN;
      OutSecBuff.pvBuffer := pOut;

      // prepare input buffer
      InBuffDesc.ulVersion := 0;
      InBuffDesc.cBuffers := 1;
      InBuffDesc.pBuffers := @InSecBuff;

      InSecBuff.cbBuffer := cbIn;
      InSecBuff.BufferType := SECBUFFER_TOKEN;
      InSecBuff.pvBuffer := pIn;

      if pAS^._fNewConversation then
        phctxt := Nil
      else
        phctxt := @pAS^._hctxt;

      ss := funcs^.AcceptSecurityContext(@pAS^._hcred, phctxt, @InBuffDesc, 0{context requirements},
              SECURITY_NATIVE_DREP, @pAS^._hctxt, @OutBuffDesc, ContextAttributes, Lifetime);
      if ss < 0 then begin
        Result := false;
        Exit;
      end
      else
        pAS^._fHaveCtxtHandle := TRUE;

      // Complete token -- if applicable
      if (ss = SEC_I_COMPLETE_NEEDED) or (ss =SEC_I_COMPLETE_AND_CONTINUE) then
        if Assigned (funcs^.CompleteAuthToken) then begin
          ss := funcs^.CompleteAuthToken (@pAS^._hctxt, @OutBuffDesc);
          if ss < 0 then
            raise Exception.CreateFmt ('complete failed: %d', [ss]);
        end
        else
          raise Exception.Create ('Complete not supported.');

      cbOut := OutSecBuff.cbBuffer;

      if pAS^._fNewConversation then
        pAS^._fNewConversation := FALSE;

      fDone := (ss <> SEC_I_CONTINUE_NEEDED) and (ss <> SEC_I_COMPLETE_AND_CONTINUE);

      result := True
    except
    end;
  end;

  function TermSession(funcs: PSecurityFunctionTable; dwKey: DWORD): boolean;
  var
    pAS: PAuthSeq;
  begin
    result := False;
    if DeleteEntry(dwKey, pointer (pAS)) then begin
      if pAS^._fHaveCtxtHandle then
        funcs^.DeleteSecurityContext (@pAS^._hctxt);
      if pAS^._fHaveCredHandle then
        funcs^.FreeCredentialHandle (@pAS^._hcred);
      freemem(pAS);
      result := True
    end
  end;

var
  done : boolean;
  cbOut, cbIn : DWORD;
  AuthIdentity : TSecWINNTAuthIdentity;
  session0OK, session1OK : boolean;
  packageHandle : THandle;

  pClientBuf : PByte;
  pServerBuf : PByte;
  cbMaxMessage : DWORD;
  funcs : PSecurityFunctionTable;
begin
  Result := False;
  try
    done := False;

    session1OK := False;
    packageHandle := 0;
    pClientBuf := Nil;
    pServerBuf := Nil;
    cbMaxMessage := 0;

    ZeroMemory(@Head, SizeOf(TNode));

    session0OK := InitSession(0);
    try
      session1OK := InitSession(1);
      packageHandle := InitPackage (cbMaxMessage, funcs);

      if session0OK and session1OK and (packageHandle <> 0) then begin
        GetMem(pClientBuf, cbMaxMessage);
        GetMem(pServerBuf, cbMaxMessage);
        FillChar(AuthIdentity, SizeOf(AuthIdentity), 0);

        if sUserName <> '' then begin
          AuthIdentity.User := PChar(sUserName);
          AuthIdentity.UserLength := Length(sUserName);
        end;

        if sDomainName <> '' then begin
          AuthIdentity.Domain := PChar(sDomainName);
          AuthIdentity.DomainLength := Length(sDomainName)
        end;

        if sPassword <> '' then begin
          AuthIdentity.Password := PChar(sPassword);
          AuthIdentity.PasswordLength := Length(sPassword)
        end
        else begin
          AuthIdentity.Password := PChar ('');
          AuthIdentity.PasswordLength := 0;
        end;
        // original C code contains check for UNICODE strings.
        AuthIdentity.Flags := SEC_WINNT_AUTH_IDENTITY_UNICODE;

        // Prepare client message (negotiate).
        cbOut := cbMaxMessage;

        if not GenClientContext(funcs, 0, @AuthIdentity, pServerBuf, 0, pClientBuf, cbOut, done) then
          raise Exception.Create('GenClientContext Failed');

        cbIn := cbOut;
        cbOut := cbMaxMessage;
        if not GenServerContext(funcs, 1, pClientBuf, cbIn, pServerBuf, cbOut, done) then
          raise Exception.Create('GenServerContext Failed');
        cbIn := cbOut;

        // Prepare client message (authenticate).
        cbOut := cbMaxMessage;
        if not GenClientContext(funcs, 0, @AuthIdentity, pServerBuf, cbIn, pClientBuf, cbOut, done) then
          raise Exception.Create('GenClientContext failed');
        cbIn := cbOut;

        // Prepare server message (authentication).
        cbOut := cbMaxMessage;
        Result := GenServerContext(funcs, 1, pClientBuf, cbIn, pServerBuf, cbOut, done)
      end;
    except
    end;
    // close session
    if Session0OK then
      TermSession(funcs, 0);
    if Session1OK then
      TermSession(funcs, 1);
    if packageHandle <> 0 then
      FreeLibrary (PackageHandle);
    if pClientBuf <> nil then
      FreeMem (pClientBuf);
    if pServerBuf <> nil then
      FreeMem (pServerBuf);
  except
  end;
end;

DigDiver

Member

Registered: 2013-04-29

Posts: 137

Re: Restrict connections count

It may be better to use ADSI (Active Directory Service Interfaces) or LDAP ?

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Currently I don't know the password check function more useful than above (ADCheckPassword)

Chaa

Member

Registered: 2011-03-26

Posts: 245

Re: Restrict connections count

Good news, that I have correct function to check password, but I don't know where in mORMot is a right place to put this function (this function used in my project for many years without any problems, but this is can't check domain password from non domain computer, I think this is not a big restriction):

Exactly same code lives in SynSSPIAuth.pas, but it does not support user authentication by user name and clear text password.
We may add function like:

function ClientSSPIAuthWithPassword(var aSecContext: TSecContext;
    const aInData: RawByteString; const aUserName: RawUTF8; { DomainName\UserName }
    const aPassword: RawUTF8; out aOutData: RawByteString): Boolean;
var
...
    AuthIdentity: TSecWinNTAuthIdentity;
begin
...
      AuthIdentity.Domain := { Extract Domain from aUserName }
      AuthIdentity.User := { Extract User from aUserName }
      AuthIdentity.Password := aPassword;
      if AcquireCredentialsHandleW(nil, SecPkgInfo^.Name, SECPKG_CRED_OUTBOUND, nil, @AuthIdentity, nil, nil, @aSecContext.CredHandle, Expiry) <> 0 then
        RaiseLastOSError;
...
end;

May be we can add some logic to interpret passClear/passKerberosSPN to TSQLRestServerAuthenticationSSPI.ClientSetUser, so in aPassword will be clear text password (passClear) or Kerberos SPN (passKerberosSPN), and call ClientSSPIAuthWithPassword/ClientSSPIAuth respectively.
For now, TSQLRestServerAuthenticationSSPI.ClientSetUser called only if aUserName = '', and that logic also must be changed.

One issue with your implementation is that the password is transmitted as plain text...
So I've tried to add simple encryption.
Not very secured yet, but better than nothing!

There is a SecEncrypt and SecDecrypt funtions with strong encryption.

P.S.
Topic name "Restrict connections count" does not match the content so happened to see it.

P.P.S.
2EgorovAlex, можно мне по почте написать, если есть вопросы.

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Chaa, yes, I think SSPI Auth functionality can be extended to support authentication by password.
And my authentication class can be removed after this. Less amount of classes - more simple to use framework.

P.S. Думаю тут всё можно решить
Another russian customer

Chaa

Member

Registered: 2011-03-26

Posts: 245

Re: Restrict connections count

There will be two different cases:

1. Client computer in domain, but application need to use different user credentials. In that case we can add TSecWinntAuthIdentity data, containg user name and password, to AcquireCredentialsHandle call.

2. Client computer not in domain. In that case we need to send user name and password (better to be encrypted) to the server. And server check user credentials in their domain. On server we may use LogonUser (requires SE_TCB_NAME privilege - server process must be run under SYSTEM machine account), or ClientSSPIAuthWithPassword + ServerSSPIAuth loop. And we need new auth scheme TSQLRestServerAuthenticationActiveDirectory (it can authenticate against local server accounts, and name ActiveDirectory did not show nature of auth scheme).

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

3. Client computer in domain, but application need to use server (computer) without domain, ClientSSPIAuthWithPassword need to use

Chaa

Member

Registered: 2011-03-26

Posts: 245

Re: Restrict connections count

3. Client computer in domain, but application need to use server (computer) without domain, ClientSSPIAuthWithPassword need to use

If server not included into domain, then it could not use domain user database (active directory) and should use local database, i.e. standard mormot auth - TSQLRestServerAuthenticationDefault.

Or application server should use external authentication server, like LDAP.

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Ok, what we should to do now? Who will add such functionality? This is will be in SSPI Auth?

Chaa

Member

Registered: 2011-03-26

Posts: 245

Re: Restrict connections count

Patches for case 1: client computer in domain, but application need to use different user credentials.
Tested only on my work machine on Windows 7.

MormotSSPIAuth-20150311.zip

For 2-3 cases, we need to know what method you want to use to check password - LogonUser, SSPI or LDAP or any other.

Сan you describe in more detail what authentication sheme you need?

EgorovAlex

Member

Registered: 2015-02-18

Posts: 43

Re: Restrict connections count

Will try your file, about 2-3 cases I think can be used your version of ClientSSPIAuthWithPassword

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

Case 1 has been integrated within http://synopse.info/fossil/info/86d1338aa2

Thanks a lot Chaa for sharing!

Chaa

Member

Registered: 2011-03-26

Posts: 245

Re: Restrict connections count

Case 1 has been integrated within http://synopse.info/fossil/info/86d1338aa2

There is some mistake with User.LogonName := '' when patching. You should remove this line.

class function TSQLRestServerAuthenticationSSPI.ClientComputeSessionKey(
  Sender: TSQLRestClientURI; User: TSQLAuthUser): RawUTF8;
begin
  result := '';
  User.LogonName := ''; // <-- do not clear, used with ClientSSPIAuthWithPassword
  InvalidateSecContext(SecCtx,'');
  try
    repeat
      if User.LogonName <> '' then
        ClientSSPIAuthWithPassword(SecCtx, InData, User.LogonName, User.PasswordHashHexa, OutData) else
        ClientSSPIAuth(SecCtx, InData, User.PasswordHashHexa, OutData);

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,232

Website

Re: Restrict connections count

Should be fixed by http://synopse.info/fossil/info/adb7018c13