mORMot Open Source

0000000000000d64  ! EXCOS EAccessViolation (c0000005 EXCEPTION_ACCESS_VIOLATION) [Main] at 02666302 mormot.rest.client.pas TRestClientAuthenticationDefault.ClientComputeSessionKey (1402)   {2 0.24 0.68 0.9GB/6GB 1db10b01}
00000000000d455f  ! ERROR ERROR: {"EAccessViolation(0d30dff0)":{Message:"Access violation at address 02666302 in module 'Horarios.exe' (offset 1606302). Read of address 0000000B"}} mormot.core.log.pas TSynLog.LogInternalFmt (6000) mormot.core.log.pas TSynLog.Log (5303) U_data.pas tTablesServer.user_loginOk (4121) U_login.pas TFRM_login.processLogin (357) U_login.pas TFRM_login.BUT_okClick (679) TControl.Click cxButtons.pas TcxCustomButton.MouseUp (2221) TControl.DoMouseUp TWinControl.WndProc TButtonControl.WndProc TWinControl.MainWndProc StdWndProc 
00000000000d491f  ! EXCOS EAccessViolation (c0000005 EXCEPTION_ACCESS_VIOLATION) [Main] at 02666302 mormot.rest.client.pas TRestClientAuthenticationDefault.ClientComputeSessionKey (1402)  mormot.rest.client.pas TRestClientAuthentication.ClientSetUser (1331) mormot.rest.client.pas TRestClientUri.SetUser (2957) U_data.pas tTablesServer.user_loginOk (4116) U_login.pas TFRM_login.processLogin (357) U_login.pas TFRM_login.BUT_okClick (679) TControl.Click cxButtons.pas TcxCustomButton.MouseUp (2221) TControl.DoMouseUp TWinControl.WndProc TButtonControl.WndProc TWinControl.MainWndProc StdWndProc  {2 0.24 0.68 0.9GB/6GB 1db10b01}

class function TRestClientAuthenticationDefault.ClientComputeSessionKey(
  Sender: TRestClientUri; User: TAuthUser): RawUtf8;
var
  resp, mcfhash, servernonce, clientnonce, proof: RawUtf8;
  clientsign: THash256;
  rnd: THash128 absolute clientsign;
  values: array[0..1] of TValuePUtf8Char;
begin
  result := ''; // error
  if User.LogonName = '' then
    exit;

  FillChar(values, SizeOf(values), 0);  //######## FIX

  // compute the 160-bit client nonce (needed by ScramClientProof)
  Random128(@rnd); // unpredictable
  Join([CardinalToHex(OSVersionInt32), '_', BinToHexLower(@rnd, SizeOf(rnd))],
    clientnonce);
  // try "mcf" for servers with "Modular Crypt" support
  if (User.PasswordHashHexa <> '') and
     (User.Data = 'mcf') then // passModularCrypt flag with clear/plain password
  begin
    User.Data := '';
    Sender.CallBackGet('auth', ['username', User.LogonName, 'mcf', 1], resp);
    JsonDecode(resp, ['result', 'mcf'], @values);
    values[0].ToUtf8(servernonce);
    if servernonce = '' then
      exit;
    // hash the password, with proper "Modular Crypt" support
    if values[1].Text <> nil then // this user got a mcf specific format
      mcfhash := ModularCryptHash(values[1].ToUtf8, User.PasswordHashHexa);
    if mcfhash <> '' then
      if values[1].Text^ = '$' then
        // no mutual auth - regular mORMot 1 hashing
        User.PasswordHashHexa := mcfhash
      else
        // SCRAM-like mutual authentication with irreversible proofs
        proof := ScramClientProof(mcfhash, User.LogonName, clientsign,
          // match ScramServerProof() msg parameters
          [Sender.fModel.Root, servernonce, clientnonce, User.LogonName])
    else
      User.SetPassword(User.PasswordHashHexa, ''); // fallback to old hash
  end
  else
    // regular authentication with User.PasswordHashHexa = hashed value
    servernonce := Sender.CallBackGetResult('auth', ['username', User.LogonName]);
  if servernonce = '' then
    exit;
  // compute and return a proof, challenged against client and server nonces
  if proof = '' then
    // regular mORMot 1 authentication via simple hexadecimal hashing
    proof := Sha256U([Sender.fModel.Root, servernonce, clientnonce,
      User.LogonName, User.PasswordHashHexa]);
  result := ClientGetSessionKey(Sender, User, [
    'username',    User.LogonName,
    'password',    proof,
    'clientnonce', clientnonce]);
  // now result <> '' contains 'id-privatekey' on authentication success
  if (values[1].Text <> nil) and      //######## ERROR: EAccessViolation - depending on Optimization and Windows version 
     (values[1].Text^ = '#') then
    // authenticate the SCRAM server from the returned proof
    if result = '' then
      User.PasswordHashHexa := ''
    else if ScramClientServerAuth(mcfhash, User.LogonName,
              Sender.fSession.ScramServerProof, clientsign) then
      // success: fSession.PrivateKey computed without the server DB key
      User.PasswordHashHexa := '#'
    else
      result := ''; // error
end;

procedure TDCS_ServerDB.sessions_kill(Ctxt: TSQLRestServerURIContext; arrSessions_kill: tArrayOfInt64);
var
  i, i2:       int64;
  countDel:    integer;
  currSession: TAuthSession;
begin
  countDel := 0;

  if (self = nil) or (fSessions = nil) or (fSessions.Count = 0)
     then exit;

  fSessions.Safe.ReadWriteLock; // won't block the ReadOnlyLock methods

  try
    for i := fSessions.Count - 1 downto 0 do
        begin
        currSession := self.fSessions[i];

        for i2 := 0 to High(arrSessions_kill) do
            if currSession.ID = arrSessions_kill[i2]  then
               begin
               if countDel = 0 then fSessions.Safe.WriteLock; // upgrade the lock (seldom)
               LockedSessionDelete(i, nil);           

               inc(countDel);
               end;
        end;
  finally
    if countDel <> 0 then
       fSessions.Safe.WriteUnlock;
    fSessions.Safe.ReadWriteUnLock;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MSC_mem:        TRestServerFullMemory;
  MSR_table:      TOrmUser;
begin

  MSC_mem   := TRestServerFullMemory.CreateWithOwnModel([TOrmUser]);
  MSR_table := TOrmUser.Create;

  MSR_table.FillPrepare(MSC_mem.Orm, '');

  // Add a Record
  MSR_table.ClearProperties;
  MSR_table.SetFieldVariant('Name', 'Paula');
  MSR_table.SetFieldVariant('Age',  48);
  MSC_mem.Add(MSR_table, true);

  // Add another Record
  MSR_table.ClearProperties;
  MSR_table.SetFieldVariant('Name', 'Maria');
  MSR_table.SetFieldVariant('Age',  48);
  MSC_mem.Add(MSR_table, true);


  // Save JSON
  MSR_table.FillPrepare(MSC_mem.Orm, '');
  Memo1.Lines.Text := MSR_table.FillTable.GetJSONValues(true);


  MSR_table.Free;
  MSC_mem.Free;
end;

procedure TDCS_ServerDB.kill_otherGroupSessions(Ctxt: TSQLRestServerURIContext);
var
  i:           integer;
  currSession: TAuthSession;
begin
  self.fSessions.Safe.Lock;

  for i := self.fSessions.Count - 1 downto 0 do
      begin
      currSession := (self.fSessions[i] as TAuthSession);

      if (currSession.GroupID     = Ctxt.SessionGroup) and
         (currSession.IDCardinal <> Ctxt.Session)      then
         self.SessionDelete(i, Ctxt);
      end;

  self.fSessions.Safe.UnLock;
end;