Bugs with TSQLRestClientURI.OnAuthentificationFailed

jbroussia · 2017-03-03 10:21:06

Hi ab,

There are a couple bugs in TSQLRestClientURI.URI in regard to the re-authentification process, for ex. when the server had to be restarted and lost information about opened sessions.

First, it seems that MaximumAuthentificationRetry is ignored, the event will keep firing as long as the authentification fails ?

Then, and it's quite difficult to explain, the algorithm is acting weird: in case the first try fails, then it is not possible anymore to authentificate with the correct credentials on subsequent tries.

Shortened code:

uses mORMotUILogin;

procedure TfrmClient.FormShow(Sender: TObject);
begin
  // ...
  // Client.MaximumAuthentificationRetry := 3;
  // Client.RetryOnceOnTimeout := FALSE;
  Client.OnAuthentificationFailed := TryLogin;
  // ...
end;

function TfrmClient.TryLogin(Retry: Integer; var aUserName, aPassword: string; out aPasswordHashed: Boolean): Boolean;
begin
  Result := TLoginForm.Login('Authentification required', 'Please enter your credentials', aUserName, aPassword, TRUE, '');
end;

Steps to reproduce:
- start server, start and connect client
- stop/restart server
- query the server from the client (re-authentification required)
- enter a wrong password at first try
- enter the correct username/password at subsequent tries: -> authentification keeps failing.

warleyalex · 2017-03-03 14:08:59

Indeed, the authentication keeps failing, the Result is always true;

jbroussia · 2017-03-03 18:07:40

Hi warleyalex,

I'm not sure if you confirm the problem or if you're saying that my code fails because "Result := TLoginForm.Login..." is always true ?
According to the comments in mORMot code, the function assigned to OnAuthentificationFailed:

// - should return TRUE if aUserName and aPassword both contain some entered
// values to be sent for remote secure authentication
// - should return FALSE if the user pressed cancel or the number of Retry
// reached a defined limit

For my testing purpose, I don't check if aUsername and aPassword are empty (as I manually enter some text), so the result is TRUE if ModalResult is mrOK, FALSE if mrCancel.

Last edited by jbroussia (2017-03-03 18:10:40)

warleyalex · 2017-03-03 19:02:15

I can confirm the issue.
If you enter the correct credentials at 1st try; work as expected.
If you enter the wrong credentials at 1st try; the subsequent tries... it keeps failing - you are not re-authenticated;

jbroussia · 2017-03-03 19:31:47

Thanks.
By the way, while you are here: great videos, but quite difficult to watch as you often type/show code on screen at the same time that comments are displayed below... and then there is extra music ! :-D

warleyalex · 2017-03-03 22:30:57

I've read today this comment:

"For me, spreading ignorance (or bad information due to ignorance) is an issue. If you are gonna talk about subject XYZ, make sure you know subject XYZ, well enough to talk about it. At least, make sure that you are not making gross errors about subject XYZ. Is it really too much to ask?"

I really like this comment, believe, I'm not truly qualified to answer this question, a long time that I really play with mORMot. Forget, hum, I'm fuck crazy guy, whatever, I will take some inspiration of the above comment, and I'll try to create another mORMot video tomorrow, stay tuned. We need to tame this little beast.

Hey, Can you confirm, it seems this crappy code is working, take a look:

function TForm2.ClientFallisceAutenticazioneEvento(Retry: integer; var
  aUserName, aPassword: string; out aPasswordHashed: boolean): Boolean;
begin
  for Retry := -1 to Database.MaximumAuthentificationRetry do
  begin
    Database.MaximumAuthentificationRetry := Retry - 1;

    case Retry of
      0, 1, 2:
        begin
          if TLoginForm.Login('Authentication', 'Please enter your credentials',
            aUserName, aPassword, TRUE, '') then
          begin
            result := Database.SetUser(aUserName, aPassWord);
            if result then
            begin
              break;
              exit;
            end
            else
              result := false;
          end;
        end;
    end;
  end;
  result := true;
end;

jbroussia · 2017-03-04 07:44:29

Hum, no it doesn't work :-( The behavior is even stranger ! For ex. after a second server restart, the event is not fired anymore so the user is not asked for credentials anymore. Also, same as before, it does only work if username/password are correct at first try, not for subsequent tries.

You shouldn't call SetUser anyways, as it is called in TSQLRestClientURI.URI if any credentials were input:

if not OnAuthentificationFailed(Retry+2,aUserName,aPassword,aPasswordHashed) or
  not SetUser(StringToUTF8(aUserName),StringToUTF8(aPassword),aPasswordHashed) then
  break;

About the comment: I agree, but not everybody is able to tell if they really know enough about XYZ. Most people believe they know it all. So many times I've seen people discover a new passion and start spreading their "knowledge" as experts after just a couple of weeks or months: it takes years if not decades to become an expert in something ! Anyways, if you are aware that you are not an expert , that you still have a lot to learn, then you can still talk about subject XYZ, if you explain your audience that what you say is not definitive and has to be taken with an open mind.
Looking forward for your next videos :-)

jbroussia · 2017-03-05 08:01:53

I think the first bug in TSQLRestClientURI.URI is that:

if not OnAuthentificationFailed(Retry+2,aUserName,aPassword,aPasswordHashed) or
  not SetUser(StringToUTF8(aUserName),StringToUTF8(aPassword),aPasswordHashed) then
  break;

should be:

if not OnAuthentificationFailed(Retry+2,aUserName,aPassword,aPasswordHashed) or
  SetUser(StringToUTF8(aUserName),StringToUTF8(aPassword),aPasswordHashed) then
  break;

???

After modifying this line, then remain at least one bug and one "problem":
* it seems there is a bug of "recursivity" with counting/incrementing the Retry variable:
- if wrong credentials are input, Retry doesn't increase; if correct credentials are input, Retry does increase ???
- if wrong credentials are input before the correct credentials, then you have to input the correct credentials "X+1" times, where X is the number of times you input wrong credentials. So if my first try is incorrect, then I need to input the correct credentials 2 times to be authenticated. If my first 2 tries are incorrect then I need to input the correct credentials 3 times !?

* then there is a problem, in that, I think, once the credentials are correct and validated, the request should not return an empty result ? It seems there should be a call to "InternalURI(Call);" somewhere after authentication worked ?

jbroussia · 2017-03-06 18:08:52

After playing with the code in mORMot TSQLRestClientURI.URI function, I have authentication retries "almost" working:

function TSQLRestClientURI.URI(const url, method: RawUTF8; Resp, Head, SendData: PRawUTF8): Int64Rec;
var
  Retry: Integer;
  aUserName, aPassword: string;
  StatusMsg: RawUTF8;
  Call: TSQLRestURIParams;
  aPasswordHashed: Boolean;

  procedure DoRetry;
  begin
    Call.Url := url;
    if fSessionAuthentication <> nil then
      fSessionAuthentication.ClientSessionSign(Self, Call);
    Call.Method := method;
    if SendData <> nil then
      Call.InBody := SendData^;

    {$ifndef LVCL}
    if Assigned(fOnIdle) then begin
      if fBackgroundThread = nil then
        fBackgroundThread := TSynBackgroundThreadEvent.Create(OnBackgroundProcess, OnIdle, FormatUTF8('% "%" background', [Self, Model.Root]));
      if not fBackgroundThread.RunAndWait(@Call) then
        Call.OutStatus := HTTP_UNAVAILABLE;
    end
    else
    {$endif}
    begin
      InternalURI(Call);
      if not(ioNoOpen in fInternalOpen) then
        if (Call.OutStatus = HTTP_NOTIMPLEMENTED) and (ioOpened in fInternalOpen) then begin
          InternalClose;     // force recreate connection
          Exclude(fInternalOpen, ioOpened);
          InternalURI(Call); // try request again
        end
        else
          Include(fInternalOpen, ioOpened);
    end;

    Result.Lo := Call.OutStatus;
    Result.Hi := Call.OutInternalState;
    if Head <> nil then
      Head^ := Call.OutHead;
    if Resp <> nil then
      Resp^ := Call.OutBody;
    fLastErrorCode := Call.OutStatus;
  end;

begin
  if Self = nil then begin
    Int64(Result) := HTTP_UNAVAILABLE;
    SetLastException(nil, HTTP_UNAVAILABLE);
    Exit;
  end;

  fLastErrorMessage := '';
  fLastErrorException := nil;
  if fServerTimeStampOffset = 0 then begin
    if not ServerTimeStampSynchronize then begin
      Int64(Result) := HTTP_UNAVAILABLE;
      Exit; // if TimeStamp is not available, server is down!
    end;
  end;

  Call.Init;
  if (Head <> nil) and (Head^ <> '') then
    Call.InHead := Head^;
  if fSessionHttpHeader <> '' then
    Call.InHead := Trim(Call.InHead + #13#10 + fSessionHttpHeader);

  try
    DoRetry;
    if (Call.OutStatus = HTTP_TIMEOUT) and RetryOnceOnTimeout then begin
      InternalLog('% % returned "408 Request Timeout" -> RETRY', [method, url], sllError);
      DoRetry;
    end
    else if (Call.OutStatus = HTTP_FORBIDDEN) and Assigned(OnAuthentificationFailed) then begin
      Retry := 1;
      while Retry <= MaximumAuthentificationRetry do begin
        // "403 Forbidden" in case of authentication failure -> try relog
        if OnAuthentificationFailed(Retry, aUserName, aPassword, aPasswordHashed)
        and SetUser(StringToUTF8(aUserName), StringToUTF8(aPassword), aPasswordHashed) then begin
          DoRetry;
          Break;
        end;
        Inc(Retry);
      end;
    end;

    if not StatusCodeIsSuccess(Call.OutStatus) then begin
      StatusCodeToErrorMsg(Call.OutStatus, StatusMsg);
      if Call.OutBody = '' then
        fLastErrorMessage := StatusMsg
      else
        fLastErrorMessage := Call.OutBody;
      InternalLog('% % returned % (%) with message  %', 
        [method, url, Call.OutStatus, StatusMsg, fLastErrorMessage], sllError);
      if Assigned(fOnFailed) then
        fOnFailed(Self, nil, @Call);
    end;

  except
    on E: Exception do begin
      Int64(Result) := HTTP_NOTIMPLEMENTED; // 501
      SetLastException(E, HTTP_NOTIMPLEMENTED, @Call);
      Exit;
    end;
  end;
end;

But there is still that problem with recursivity, because SetUser calls back TSQLRestClientURI.URI so we're caught in a loop.

What would be the best, clean way to get out of it ?

Thanks !

Edit: for this code to "work" I also set MaximumAuthentificationRetry default value to 1.

Last edited by jbroussia (2017-03-06 18:11:23)

jbroussia · 2017-03-09 10:33:12

So I now have it working as expected, plus the calling query will be executed once the user is re-authenticated, with code modified as follow:

Modifications in TSQLRestClientURI:
- Added a variable to check if we're in authentication loop

TSQLRestClientURI = class(TSQLRestClient)
  protected
    fInAuthenticationLoop: Boolean;
    // ...

- Modified the default value of property MaximumAuthentificationRetry to 1 (as a value of 0 to retry once doesn't make sense to me ?)

property MaximumAuthentificationRetry: Integer
  read fMaximumAuthentificationRetry write fMaximumAuthentificationRetry default 1;

- And TSQLRestClientURI.URI modified to this:

function TSQLRestClientURI.URI(const url, method: RawUTF8; Resp, Head, SendData: PRawUTF8): Int64Rec;
var
  Retry: Integer;
  aUserName, aPassword: string;
  StatusMsg: RawUTF8;
  Call: TSQLRestURIParams;
  aPasswordHashed: Boolean;

  procedure DoRetry;
  begin
    Call.Url := url;
    if fSessionAuthentication <> nil then
      fSessionAuthentication.ClientSessionSign(Self, Call);
    Call.Method := method;
    if SendData <> nil then
      Call.InBody := SendData^;

    {$ifndef LVCL}
    if Assigned(fOnIdle) then begin
      if fBackgroundThread = nil then
        fBackgroundThread := TSynBackgroundThreadEvent.Create(OnBackgroundProcess, OnIdle, FormatUTF8('% "%" background', [Self, Model.Root]));
      if not fBackgroundThread.RunAndWait(@Call) then
        Call.OutStatus := HTTP_UNAVAILABLE;
    end
    else
    {$endif}
    begin
      InternalURI(Call);
      if not(ioNoOpen in fInternalOpen) then
        if (Call.OutStatus = HTTP_NOTIMPLEMENTED) and (ioOpened in fInternalOpen) then begin
          InternalClose;     // force recreate connection
          Exclude(fInternalOpen, ioOpened);
          InternalURI(Call); // try request again
        end
        else
          Include(fInternalOpen, ioOpened);
    end;

    Result.Lo := Call.OutStatus;
    Result.Hi := Call.OutInternalState;
    if Head <> nil then
      Head^ := Call.OutHead;
    if Resp <> nil then
      Resp^ := Call.OutBody;
    fLastErrorCode := Call.OutStatus;
  end;

begin
  if Self = nil then begin
    Int64(Result) := HTTP_UNAVAILABLE;
    SetLastException(nil, HTTP_UNAVAILABLE);
    Exit;
  end;

  fLastErrorMessage := '';
  fLastErrorException := nil;
  if fServerTimeStampOffset = 0 then begin
    if not ServerTimeStampSynchronize then begin
      Int64(Result) := HTTP_UNAVAILABLE;
      Exit; // if TimeStamp is not available, server is down!
    end;
  end;

  Call.Init;
  if (Head <> nil) and (Head^ <> '') then
    Call.InHead := Head^;
  if fSessionHttpHeader <> '' then
    Call.InHead := Trim(Call.InHead + #13#10 + fSessionHttpHeader);

  try
    DoRetry;
    if (Call.OutStatus = HTTP_TIMEOUT) and RetryOnceOnTimeout then begin
      InternalLog('% % returned "408 Request Timeout" -> RETRY', [method, url], sllError);
      DoRetry;
    end
    else if (Call.OutStatus = HTTP_FORBIDDEN) and Assigned(OnAuthentificationFailed) and not fInAuthenticationLoop then begin
      fInAuthenticationLoop := TRUE;
      Retry := 1;
      while Retry <= MaximumAuthentificationRetry do begin
        // "403 Forbidden" in case of authentication failure -> try relog
        if OnAuthentificationFailed(Retry, aUserName, aPassword, aPasswordHashed)
        and SetUser(StringToUTF8(aUserName), StringToUTF8(aPassword), aPasswordHashed) then begin
          DoRetry;
          fInAuthenticationLoop := FALSE;
          Break;
        end;
        Inc(Retry);
      end;
    end;

    if not StatusCodeIsSuccess(Call.OutStatus) then begin
      StatusCodeToErrorMsg(Call.OutStatus, StatusMsg);
      if Call.OutBody = '' then
        fLastErrorMessage := StatusMsg
      else
        fLastErrorMessage := Call.OutBody;
      InternalLog('% % returned % (%) with message  %', 
        [method, url, Call.OutStatus, StatusMsg, fLastErrorMessage], sllError);
      if Assigned(fOnFailed) then
        fOnFailed(Self, nil, @Call);
    end;

  except
    on E: Exception do begin
      Int64(Result) := HTTP_NOTIMPLEMENTED; // 501
      SetLastException(E, HTTP_NOTIMPLEMENTED, @Call);
      Exit;
    end;
  end;
end;

Maybe not the cleanest code (hey, not worse than using goto labels ! :-P), but it works for me.

Can anyone have a look and give me some feedback ?
Thanks

Last edited by jbroussia (2017-03-09 10:34:15)

warleyalex · 2017-03-09 19:10:27

I think there an issue on the 2nd reconnection.
http://i.makeagif.com/media/3-09-2017/T2uxmP.gif

jbroussia · 2017-03-09 19:25:13

I can't reproduce it, can you describe the steps required ?

warleyalex · 2017-03-09 19:45:59

See athttp://i.makeagif.com/media/3-09-2017/T2uxmP.gif
a. server and client is Up
b. disconnect server and then
c. restart server
d. reconnect the client 1st time (you have 3 chances to guess the credentials) // it is working
e. disconnect server
f. restart server
f. try to reconnect the client (now you've got forbidden 403)

jbroussia · 2017-03-09 20:08:35

Nope, still can't reproduce it :-\ I can disconnect the server as much as I want, and when I restart it and reconnect the client, the authentication process works as expected.
What if you comment out the last DoRetry (as in original code) ?

if OnAuthentificationFailed(Retry, aUserName, aPassword, aPasswordHashed)
and SetUser(StringToUTF8(aUserName), StringToUTF8(aPassword), aPasswordHashed) then begin
  // DoRetry;
  fInAuthenticationLoop := FALSE;
  Break;
end;

warleyalex · 2017-03-09 21:34:44

...I had to just unpack, another clean mORMot and patched the units and... tandãã... it worked as expected!

/\(^_^)/\

Mr. AB could take a look at this code.

Last edited by warleyalex (2017-03-09 21:35:57)

jbroussia · 2017-03-10 08:01:02

Nice, thank you for your feedback !

EMartin · 2017-03-10 11:01:06

@jbroussia, create a ticket with the problem and the solution, @ab never answered in this thread.

jbroussia · 2017-03-10 16:49:00

OK, I did. I don't know the rules on how to create a ticket, I hope it will be accepted.

ab · 2017-03-10 18:08:58

Accepted and committed (with minor changes)...

Thanks a lot for the feedback!

mORMot Open Source

#1 2017-03-03 10:21:06

Bugs with TSQLRestClientURI.OnAuthentificationFailed

#2 2017-03-03 14:08:59

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#3 2017-03-03 18:07:40

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#4 2017-03-03 19:02:15

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#5 2017-03-03 19:31:47

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#6 2017-03-03 22:30:57

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#7 2017-03-04 07:44:29

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#8 2017-03-05 08:01:53

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#9 2017-03-06 18:08:52

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#10 2017-03-09 10:33:12

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#11 2017-03-09 19:10:27

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#12 2017-03-09 19:25:13

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#13 2017-03-09 19:45:59

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#14 2017-03-09 20:08:35

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#15 2017-03-09 21:34:44

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#16 2017-03-10 08:01:02

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#17 2017-03-10 11:01:06

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#18 2017-03-10 16:49:00

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

#19 2017-03-10 18:08:58

Re: Bugs with TSQLRestClientURI.OnAuthentificationFailed

Board footer