Posts by Sabbiolina

Sabbiolina · mORMot 1

Hi,
Mormot not work that way.
Read the blog: Authentication-and-Authorization

briefly:
Here are the typical steps to be followed in order to create a new user session via mORMot authentication scheme:
- Client sends a GET ModelRoot/auth?UserName=... request to the remote server;
- Server answers with an hexadecimal nonce contents (valid for about 5 minutes), encoded as JSON result object;
- Client sends a GET ModelRoot/auth?UserName=...&PassWord=...&ClientNonce=... request to the remote server, in which ClientNonce is a random value used as Client nonce, and PassWord is computed from the log-on and password entered by the User, using both Server and Client nonce as salt;
- Server checks that the transmitted password is valid, i.e. that its matches the hashed password stored in its database and a time-valid Server nonce - if the value is not correct, authentication fails;

Sabbiolina · mORMot 1

Hi AB,
have you had time to do some testing?

Sabbiolina · mORMot 1

HI,
each user must map a different root, which corresponds to a different db.

look at 'rtest':

  MongoClient := TMongoClient.Create('localhost',27017);
  DB := MongoClient.Database['testODM'];
  Model := TSQLModel.Create([TSQLORM,TSQLauthUser,TSQLauthGroup]); // <<-------------------- root

  MongoClient2 := TMongoClient.Create('localhost',27017);
  DB2 := MongoClient2.Database['testODM2'];
  Model2 := TSQLModel.Create([TSQLORM,TSQLauthUser,TSQLauthGroup],'rtest'); //<------------------------------------- rtest


  // create the main mORMot server
  aRestServer := TSQLRestServerDB.Create(Model,':memory:',false);
  aRestServer2 := TSQLRestServerDB.Create(Model2,':memory:',false);

 // serve aRestServer data over HTTP
 aHttpServer := TSQLHttpServer.Create(SERVER_PORT,[aRestServer],'+',useHttpApiRegisteringURI);
 aHttpServer.AddServer(aREstSErver2);

Sabbiolina · mORMot 1

Personally I only read them.

In the first post you can see the result of:

resUTF8: = fdb.RunCommand ('replSetGetStatus', res);

Sabbiolina · mORMot 1

I got it.

Now you will write the changes to auto decode it?

Sabbiolina · mORMot 1

but: >>>>ï¿°C<<<<< ?

Sabbiolina · mORMot 1

no...

look at optime and electionTime

looks like a base64 ...

this from delphi debugger: "optime":"ï¿°CgAAADYnK1Q="

ResutUTF8: {"set":"rs0",
"date":"2014-10-01T19:47:42",
"myState":1,
"members":[{"_id":0,
"name":"WIN-G1V0GLAHABK:27019",
"health":1,
"state":2,
"stateStr":"SECONDARY",
"uptime":689,
"optime":"￰￰CgAAADYnK1Q=",
"optimeDate":"2014-09-30T21:57:10",
"lastHeartbeat":"2014-10-01T19:47:40",
"lastHeartbeatRecv":"2014-10-01T19:47:41",
"pingMs":0,
"syncingTo":"192.168.172.130:27020"},
{"_id":1,
"name":"192.168.172.130:27018",
"health":1,
"state":2,
"stateStr":"SECONDARY",
"uptime":689,
"optime":"￰CgAAADYnK1Q=",
"optimeDate":"2014-09-30T21:57:10",
"lastHeartbeat":"2014-10-01T19:47:41",
"lastHeartbeatRecv":"2014-10-01T19:47:41",
"pingMs":1,
"syncingTo":"192.168.172.130:27020"},
{"_id":2,
"name":"192.168.172.130:27020",
"health":1,
"state":1,
"stateStr":"PRIMARY",
"uptime":690,
"optime":"￰CgAAADYnK1Q=",
"optimeDate":"2014-09-30T21:57:10",
"electionTime":"￰AQAAALNXLFQ=",
"electionDate":"2014-10-01T19:36:19",
"self":true}],
"ok":1}

Sabbiolina · mORMot 1

Hi AB.

I plan to propose some basic changes to the management of connections to a mongodb in replicaset.

looking at your code I see that you assume that fconnections [0] contains the link to the mongodb primary, and [1..n] to the secondary.

This assumption is not true.
Mongodb, operates internally, or on command, its morphology.

Today, the primary server is 1 and 2, 3, 4 secondary.

But if 1 has problems, it could become the 2 primary and 1 on his return online would become secondary.

So every assumption is wrong.

The solution is to dynamically adapt to these changes.

this function deals with the first connection, switches fconnection so that there is 0 in the primary (not beautiful but functional).

function TMongoClient.Open(const DatabaseName: RawUTF8): TMongoDatabase;
var
 success:boolean;
 n:integer;
 tmpConn:TMongoConnection;
begin
  if self=nil then
   result := nil else
   begin
    result := TMongoDatabase(fDatabases.GetObjectByName(DatabaseName));
     n:=high(fConnections);
     if result=nil then
     begin // not already opened -> try now from primary host
      repeat
       if not fConnections[0].Opened then
        fConnections[0].Open;
       try
        result := TMongoDatabase.Create(Self,DatabaseName);
        success:=true;
       except
        success:=false;

        if n>0 then
        begin
         tmpconn:=Fconnections[0]; // switch connection until works
         Fconnections[0]:=Fconnections[n];
         Fconnections[n]:=tmpConn;
         dec(n);
        end;
       end;
      until success or (n=0);
     end;
    fDatabases.AddObject(DatabaseName,result);
   end;

  if result=nil then
    raise EMongoException.CreateUTF8('%.Open: unknown database "%"',[self,DatabaseName]);
end;

Now we must do the same in the case of exceptions in writing.

procedure TMongoCollection.Insert(const Documents: array of variant;
  Flags: TMongoInsertFlags; NoAcknowledge: boolean);
begin
  Database.Client.Connections[0].SendAndFree(TMongoRequestInsert.Create(
    fFullCollectionName,Documents,Flags),NoAcknowledge);
end;

Here I leave to you to decide where it is best to make the switch.

We could also use the command 'replSetGetStatus' that returns the list of servers in the replicaset indicate whether they are primary and in health.

Sabbiolina · mORMot 1

Temporary solution: (ignore it)

add two line:

procedure TBSONElement.AddMongoJSON(W: TTextWriter; Mode: TMongoJSONMode);
label bin,regex;
begin
  case Kind of
  betFloat:
    W.Add(PDouble(Element)^);
  betString, betJS, betDeprecatedSymbol: begin
    W.Add('"');
    W.AddJSONEscape(Data.Text,Data.TextLen);
    W.Add('"');
  end;
  betDoc, betArray:
    BSONListToJSON(Data.DocList,Kind,W,Mode);
  betObjectID: begin
    W.AddShort(BSON_JSON_OBJECTID[false,Mode]);
    W.AddBinToHex(Element,SizeOf(TBSONObjectID));
    W.AddShort(BSON_JSON_OBJECTID[true,Mode]);
  end;
  betDeprecatedUndefined:
    W.AddShort(BSON_JSON_UNDEFINED[Mode=modMongoShell]);
  betBinary:
  case Mode of
  modNoMongo:
    W.WrBase64(Data.Blob,Data.BlobLen,true);
  modMongoStrict: begin
    W.AddShort(BSON_JSON_BINARY[false,false]);
    W.WrBase64(Data.Blob,Data.BlobLen,false);
    W.AddShort(BSON_JSON_BINARY[false,true]);
    W.AddBinToHex(@Data.BlobSubType,1);
    W.AddShort('"}');
  end;
  modMongoShell: begin
    W.AddShort(BSON_JSON_BINARY[true,false]);
    W.AddBinToHex(@Data.BlobSubType,1);
    W.AddShort(BSON_JSON_BINARY[true,true]);
    W.WrBase64(Data.Blob,Data.BlobLen,false);
    W.AddShort('")');
  end;
  end;
  betRegEx:
  case Mode of
  modNoMongo:
bin:W.WrBase64(Element,ElementBytes,true);
  modMongoStrict:
    goto regex;
  modMongoShell:
    if (PosChar(Data.RegEx,'/')=nil) and
       (PosChar(Data.RegExOptions,'/')=nil) then begin
      W.Add('/');
      W.AddNoJSONEscape(Data.RegEx,Data.RegExLen);
      W.Add('/');
      W.AddNoJSONEscape(Data.RegExOptions,Data.RegExOptionsLen);
    end else begin
regex:W.AddShort(BSON_JSON_REGEX[0]);
      W.AddJSONEscape(Data.RegEx,Data.RegExLen);
      W.AddShort(BSON_JSON_REGEX[1]);
      W.AddJSONEscape(Data.RegExOptions,Data.RegExOptionsLen);
      W.AddShort(BSON_JSON_REGEX[2]);
    end;
  end;
  betDeprecatedDbptr:
    goto bin; // no specific JSON construct for this deprecated item
  betJSScope:
    goto bin; // no specific JSON construct for this item yet
  betTimeStamp: // <<----------------------------------------------------add this
    goto bin;       // <<----------------------------------------------------add this
  betBoolean:
    W.AddString(JSON_BOOLEAN[PBoolean(Element)^]);
  betDateTime: begin
    W.AddShort(BSON_JSON_DATE[Mode,false]);
    W.AddDateTime(UnixMSTimeToDateTime(PInt64(Element)^));
    W.AddShort(BSON_JSON_DATE[Mode,true]);
  end;
  betNull:
    W.AddShort('null');
  betInt32:
    W.Add(PInteger(Element)^);
  betInt64:
    W.Add(PInt64(Element)^);
  else
  if Kind=betMinKey then
    W.AddShort(BSON_JSON_MINKEY[Mode=modMongoShell]) else
  if Kind=betMaxKey then
    W.AddShort(BSON_JSON_MAXKEY[Mode=modMongoShell]) else
    raise EBSONException.CreateFmt('Unexpected BSON element of type %d',[ord(Kind)]);
  end;
end;

Sabbiolina · mORMot 1

DocVariantDataSafe ?

But how ?

Sabbiolina · mORMot 1

this works

  for i:=0 to res.members._Count-1 do
  begin
   log(inttostr(res.members._(i)._id)+': '+res.members._(i).name);
  end;

but,
Why the version of the previous post wrong?

Sabbiolina · mORMot 1

Hi

I receive this from mongoDB command:

res: (variant) =

{"set":"rs0",
"date":"2014-09-29T14:11:35",
"myState":1,
"members":
[
{"_id":0,"name":"127.0.0.1:27019"},
{"_id":1,"name":"192.168.172.130:27018"},
{"_id":2,"name":"192.168.172.130:27020"}
],
"ok":1}

How to read "members" ?

  log('Set_ID: '+res.set); //<-- this works

  with TDocVariantData(res.members) do
  begin
   for i := 0 to Count-1 do // <--- count 0
    log(Values[i].name); // <--- no output
  end;

Sabbiolina · mORMot 1

Surely you can have a method to finish the authentication may be interesting:
You could for example authenticate a user only if the source ip is the right one,
or on an hourly basis.
As well as keeping an eye on failed attempts.

Sabbiolina · mORMot 1

There is a problem:
The call to InitializeTable is premature.
The function to be error because it can not find the sqlite tables in memory, given that createmissingtables has not yet been called.

constructor TSQLRestStorageMongoDB.Create(aClass: TSQLRecordClass; aServer: TSQLRestServer);
begin
  inherited Create(aClass,aServer);
  // ConnectionProperties should have been set in StaticMongoDBRegister()
  fCollection := fStoredClassProps.ExternalDB.ConnectionProperties as TMongoCollection;
  {$ifdef WITHLOG}
  fOwner.LogFamily.SynLog.Log(sllInfo,'will store % using %',[aClass,Collection],self);
  {$endif}
  BSONProjectionSet(fBSONProjectionSimpleFields,true,
    fStoredClassRecordProps.SimpleFieldsBits[soSelect],nil);
  BSONProjectionSet(fBSONProjectionBlobFields,false,
    fStoredClassRecordProps.BlobFieldsBits,@fBSONProjectionBlobFieldsNames);
  CreateIndexes;

//  if not TableHasRows(StoredClass) then <---- hangs here
//    StoredClass.InitializeTable(aServer,'',INITIALIZETABLE_NOINDEX);
end;

exception:
20140926 10020713 SQL TSQLRestServerDB(02C6C800) INSERT INTO AuthGroup (Ident,SessionTimeout,AccessRights) VALUES (:('Admin'):,:(10):,:('47,1-256,0,1-256,0,1-256,0,1-256,0'):); prepared with 3 params
20140926 10021135 EXC ESQLite3Exception ("Error SQLITE_ERROR (1) - \"no such table: AuthGroup\"") at 006B3BBB stack trace API 0062A574
20140926 10021135 ERROR TSQLRestServerDB(02C6C800) {"ESQLite3Exception(02D5FA50)":{}} for INSERT INTO AuthGroup (Ident,SessionTimeout,AccessRights) VALUES (:('Admin'):,:(10):,:('47,1-256,0,1-256,0,1-256,0,1-256,0'):); stack trace API 0062BCB2 006B705A 006B608A 0068CA5D 0067C1CB 0069DA66 0074A3DF 0074A26E 0074E64D 004CA56A 004CA417 004CA3F7 005DC1C5 00759542 76D6338A 77989F72 77989F45

Sabbiolina · mORMot 1

To add some field for sure is the right way.
But here we are talking about authentication.
There is no callback to validate the user with additional fields.

Sabbiolina · mORMot 1

Hi AB.

After reading the SAD and the blog sulla'autenticazione permission and I was wondering if we could add a field to disable the user.

I already did some tests and everything seems clear and straightforward.

Tested and working:

function TSQLRestServerAuthentication.GetUser(Ctxt: TSQLRestServerURIContext;
  const aUserName: RawUTF8): TSQLAuthUser;
begin
  result := fServer.fSQLAuthUserClass.Create(fServer,'LogonName=?',[aUserName]);
  if result.fID=0 then begin
    {$ifdef WITHLOG}
    fServer.fLogFamily.SynLog.Log(sllUserAuth,
      'User.LogonName=% not found in AuthUser table',[aUserName],self);
    {$endif}
    FreeAndNil(result);
  end
  else if not result.fenabled then // added part <<-------------------------------------------

  begin
    {$ifdef WITHLOG}
    fServer.fLogFamily.SynLog.Log(sllUserAuth,
      'User.LogonName=% Disabled',[aUserName],self);
    {$endif}
    FreeAndNil(result);
  end;
end;

We must of course add the field "enabled" in the class.

  /// class of the table containing the available user access rights for authentication
  TSQLAuthGroupClass = class of TSQLAuthGroup;

  {/ table containing the Users registered for authentication
    - this class should be added to the TSQLModel, together with TSQLAuthGroup,
      to allow authentication support
    - you can inherit from it to add your custom properties to each user info:
      TSQLModel will search for any class inheriting from TSQLAuthUser to manage
      per-user authorization data
    - by default, it won't be accessible remotely by anyone; to enhance security,
      you could use the TSynValidatePassWord filter to this table  }
  TSQLAuthUser = class(TSQLRecord)
  protected
    fLogonName: RawUTF8;
    fPasswordHashHexa: RawUTF8;
    fDisplayName: RawUTF8;
    fenabled: boolean; //<<----------------------------------------------------------------------------
    fGroup: TSQLAuthGroup;
    fData: TSQLRawBlob;
    procedure SetPasswordPlain(const Value: RawUTF8);
  public
    /// able to set the PasswordHashHexa field from a plain password content
    // - in fact, PasswordHashHexa := SHA256('salt'+PasswordPlain) in UTF-8
    property PasswordPlain: RawUTF8 write SetPasswordPlain;
  published
    /// the User identification Name, as entered at log-in
    // - the same identifier can be used only once (this column is marked as
    // unique via a "stored AS_UNIQUE" - i.e. "stored false" - attribute), and
    // therefore indexed in the database (e.g. hashed in TSQLRestStorageInMemory)
    property LogonName: RawUTF8 index 20 read fLogonName write fLogonName stored AS_UNIQUE;
    /// the User Name, as may be displayed or printed
    property DisplayName: RawUTF8 index 50 read fDisplayName write fDisplayName;
    /// the UserID is gsw usercode
    /// the hexa encoded associated SHA-256 hash of the password
    property PasswordHashHexa: RawUTF8 index 64 read fPasswordHashHexa write fPasswordHashHexa;
    /// the associated access rights of this user
    // - access rights are managed by group
    // - in TAuthSession.User instance, GroupRights property will contain a
    // REAL TSQLAuthGroup instance for fast retrieval in TSQLRestServer.URI
    // - note that 'Group' field name is not allowed by SQLite
    property GroupRights: TSQLAuthGroup read fGroup write fGroup;
    /// some custom data, associated to the User
    // - Server application may store here custom data
    // - its content is not used by the framework but 'may' be used by your
    // application
    property Data: TSQLRawBlob read fData write fData;

    // enabled or not   <<----------------------------------------------------------------------------
    property Enabled: boolean read Fenabled write Fenabled; // <<----------------------------------------------------------------------------
  end;

Sabbiolina · mORMot 1

Tnxs

Sabbiolina · mORMot 1

Thanks, it works well.

I would add, for those who read the post, that the initialization of AuthGroup also creates Members in AuthUser table.

Sabbiolina · mORMot 1

Hi AB.

I'm playing with MongoDB and replicaset.

Via ORM write in Db without problems, but it always comes out the exception: unknow type 17 (betTimeStamp)

I found where to make the patch, but I do not know what to enter.

procedures TBSONElement.AddMongoJSON (W: TTextWriter; Mode: TMongoJSONMode);
bin label, regex;
begin
   Kind of homes
   betFloat:
     W.Add (PDouble (Element) ^);
   betString, betJS, betDeprecatedSymbol: begin
     W.Add ('"');
     W.AddJSONEscape (data.text, Data.TextLen);
     W.Add ('"');
   end;
   betDoc, betArray:
     BSONListToJSON (Data.DocList, Kind, W, Mode);
   betObjectID: begin
     W.AddShort (BSON_JSON_OBJECTID [false, Mode]);
     W.AddBinToHex (Element, SizeOf (TBSONObjectID));
     W.AddShort (BSON_JSON_OBJECTID [true, Mode]);
   end;
   betTimeStamp: begin
        // ***************************************************************** here
   end;

Sabbiolina · mORMot 1

Hi AB.

look at the code, if you do not call:
StaticMongoDBRegister (TSQLauthGroup, aRestServer, DB, 'myTSQLauthGroup')

I find in the db mytestcollection and myTSQLauthUser. With the basic initialization of the users (admin supervisor user).

But if I make the call, I find 3 tables but without initialization.

/// minimal REST server for a list of Persons stored on MONGODB
program RESTserver;

{$APPTYPE CONSOLE}

uses
  SynCommons,          // framework core
  mORMot,              // RESTful server & ORM
  mORMotSQLite3,       // SQLite3 engine as ORM core
  SynSQLite3Static,    // staticaly linked SQLite3 engine
  mORMotDB,            // ORM using external DB
  mORMotHttpServer,    // HTTP server for RESTful server
  SynDB,               // external DB core
  mORMotWrappers, //mormot
  SynMongoDB,mORMotMongoDB;

const
 SERVER_PORT='888';

type
 TSQLORM = class(TSQLRecord)
  private
    fAge: integer;
    fName: RawUTF8;
    fDate: TDateTime;
    fValue: variant;
    fInts: TIntegerDynArray;
    fCreateTime: TCreateTime;
    fData: TSQLRawBlob;
  published
    property Name: RawUTF8 read fName write fName stored AS_UNIQUE;
    property Age: integer read fAge write fAge;
    property Date: TDateTime read fDate write fDate;
    property Value: variant read fValue write fValue;
    property Ints: TIntegerDynArray index 1 read fInts write fInts;
    property Data: TSQLRawBlob read fData write fData;
    property CreateTime: TCreateTime read fCreateTime write fCreateTime;
  end;

var
  aHttpServer: TSQLHttpServer;

  aRestServer: TSQLRestServerDB;
  MongoClient : TMongoClient;
  Client: TSQLRestClientDB;
  DB: TMongoDatabase;
  Model:TSQLModel;
begin
  // define the log level
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    EchoToConsole := LOG_VERBOSE; // log all events to the console
  end;
  MongoClient := TMongoClient.Create('localhost',27017);
  DB := MongoClient.Database['testODM5'];
  Model := TSQLModel.Create([TSQLORM,TSQLauthGroup,TSQLauthUser]);

  try
   // create the main mORMot server
   aRestServer := TSQLRestServerDB.Create(Model,':memory:',true); // authentication=false
   try
    if StaticMongoDBRegister(TSQLauthUser,aRestServer,DB,'myTSQLauthUser')=nil then
    begin
     writeln('Error2 !'#10);  exit;
    end;
    if StaticMongoDBRegister(TSQLORM,aRestServer,DB,'mytestcollection')=nil then
    begin
     writeln('Error3 !'#10);  exit;
    end;
    if false  then //  <<<****************************************************************************
    begin
     if StaticMongoDBRegister(TSQLauthGroup,aRestServer,DB,'myTSQLauthGroup')=nil then
     begin
      writeln('Error1 !'#10);  exit;
     end;
    end;

    aRestServer.CreateMissingTables; // create tables or fields if missing
    // serve aRestServer data over HTTP
    aHttpServer := TSQLHttpServer.Create(SERVER_PORT,[aRestServer],'+',useHttpApiRegisteringURI);
    try
     aHttpServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
     writeln('Background server is running.'#10);
     writeln('Press [Enter] to close the server.');
     readln;
    finally aHttpServer.Free; end;
   finally aRestServer.Free; end;
  finally Model.Free; end;
end.

ps: I use www.robomongo.org for mongoDb easy gui

Sabbiolina · mORMot 1

Hi AB

function TSQLRest.Add(Value: TSQLRecord; SendData: boolean;
  ForceID: boolean=false): integer;
var JSONValues: RawUTF8;
    TableIndex: integer;
begin
  if Value=nil then begin
    result := 0;
    exit;
  end;
  TableIndex := Model.GetTableIndexExisting(PSQLRecordClass(Value)^);
  if SendData then begin
    Value.ComputeFieldsBeforeWrite(self,seAdd); // update TModTime/TCreateTime fields
    if Model.TableProps[TableIndex].Kind in INSERT_WITH_ID then
      ForceID := true;
    JSONValues := Value.GetJSONValues(true, // true=expanded
      (Value.fID<>0) and ForceID,soInsert);
  end else
    JSONValues := '';
  // on success, returns the new ROWID value; ************************ on error, returns 0 **************************
  result := EngineAdd(TableIndex,JSONValues); // will call static
  // on success, Value.ID is updated with the new ROWID

  Value.fID := result; 
  if SendData then ********************* result not checked maybe better: if SendData and (result<>0) then ?
    fCache.Notify(PSQLRecordClass(Value)^,result,JSONValues,soInsert);
end;

Not a bug, but

EngineAdd on error, returns 0
but not checked

Sabbiolina · mORMot 1

What you think about?

Sabbiolina · mORMot 1

Hi AB

function TSQLRestCache.CachedEntries: cardinal;
var i,j: integer;
begin
  result := 0;
  if self<>nil then
    for i := 0 to high(fCache) do
      with fCache[i] do
      if CacheEnable then
      for j := 0 to Count-1 do
        if Values[j].TimeStamp64<>0 then
          inc(result);
end;

given that the cycle works with Values [] would be better to put it under CriticalSection:

function TSQLRestCache.CachedEntries: cardinal;
var i,j: integer;
begin
 EnterCriticalSection(Mutex);
 try
  result := 0;
  if self<>nil then
    for i := 0 to high(fCache) do
      with fCache[i] do
      if CacheEnable then
      for j := 0 to Count-1 do
        if Values[j].TimeStamp64<>0 then
          inc(result);

  finally
    LeaveCriticalSection(Mutex);
  end;
end;

also
function TSQLRestCache.CachedEntries: cardinal;

Sabbiolina · mORMot 1

After reading the source code SAD and quardando about REST level client-side cache, I noticed that there is not a limit ram usage / number of records.

Perhaps it is best to add?

Sabbiolina · mORMot 1

I found the problem:

JSON='[]';

function TBSONWriter.BSONWriteDocFromJSON(JSON: PUTF8Char; aEndOfObject: PUTF8Char;
  out Kind: TBSONElementType; DoNotTryExtendedMongoSyntax: boolean): PUTF8Char;
var Start, ndx: cardinal;
    EndOfObject: AnsiChar;
    Name: RawUTF8;
begin
  result := nil;
  if JSON=nil then
    exit;
  if JSON^ in [#1..' '] then repeat inc(JSON) until not(JSON^ in [#1..' ']);
  case JSON^ of
  '[': begin
    Kind := betArray;
    Start := BSONDocumentBegin;
    repeat inc(JSON) until not(JSON^ in [#1..' ']);
    ndx := 0;
    repeat
      UInt32ToUtf8(ndx,Name);
      BSONWriteFromJSON(Name,JSON,@EndOfObject,DoNotTryExtendedMongoSyntax);
      if JSON=nil then
        exit; // invalid content
      inc(ndx);
    until EndOfObject=']'; <---- EndoOfObject is #0
  end;

 [...]

the value returned by BSONWriteFromJSON in EndOfObject is # 0

but with:

until (EndOfObject=']') or (EndOfObject=#0) ;

WORKS!!!
the record in mongodb is written.

Addendum:
{
"_id" : 1,
"Name" : "Name8558",
"Age" : 0,
"Date" : ISODate("1899-12-30T00:00:00.000Z"),
"Value" : null,
"Ints" : [
null <-- wrong ?
],
"CreateTime" : NumberLong(135193354702)
}

Sabbiolina · mORMot 1

I had already tried to do that solution.

but at the first client call I get an out of memory error.

and I see the processor consumption rise rapidly.

it seems that there is an infinite recursion

nothing is saved in mongodb and it takes a minute to finish the server.

now I'm debugging: procedure TBSONWriter.BSONWriteFromJSON

Sabbiolina · mORMot 1

I'm sorry, I do not understand.

StaticMongoDBRegister call before the start of the server.

What server are you referring to?

Sabbiolina · mORMot 1

I've lost something ...

Server:

/// minimal REST server for a list of Persons stored on MONGODB
program RESTserver;

{$APPTYPE CONSOLE}

uses
  SynCommons,          // framework core
  mORMot,              // RESTful server & ORM
  mORMotSQLite3,       // SQLite3 engine as ORM core
  SynSQLite3Static,    // staticaly linked SQLite3 engine
  mORMotDB,            // ORM using external DB
  mORMotHttpServer,    // HTTP server for RESTful server
  SynDB,               // external DB core
  SynMongoDB,mORMotMongoDB;

const
 SERVER_PORT='888';

type
 TSQLORM = class(TSQLRecord)
  private
    fAge: integer;
    fName: RawUTF8;
    fDate: TDateTime;
    fValue: variant;
    fInts: TIntegerDynArray;
    fCreateTime: TCreateTime;
    fData: TSQLRawBlob;
  published
    property Name: RawUTF8 read fName write fName stored AS_UNIQUE;
    property Age: integer read fAge write fAge;
    property Date: TDateTime read fDate write fDate;
    property Value: variant read fValue write fValue;
    property Ints: TIntegerDynArray index 1 read fInts write fInts;
    property Data: TSQLRawBlob read fData write fData;
    property CreateTime: TCreateTime read fCreateTime write fCreateTime;
  end;

var
  aRestServer: TSQLRestServerDB;
  aHttpServer: TSQLHttpServer;
  MongoClient : TMongoClient;
  Client: TSQLRestClientDB;
  DB: TMongoDatabase;
  Model :TSQLModel;
begin
  // define the log level
  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    EchoToConsole := LOG_VERBOSE; // log all events to the console
  end;

  MongoClient := TMongoClient.Create('localhost',27017);
  DB := MongoClient.Database['testODM'];
  Model := TSQLModel.Create([TSQLORM]);
  Client := TSQLRestClientDB.Create(Model,nil,':memory:',TSQLRestServerDB);
  if StaticMongoDBRegister(TSQLORM,Client.Server,DB,'mytestcollection')=nil then
  begin
   writeln('Error !'#10);
   exit;
  end;
  try
   // create the main mORMot server
   aRestServer := TSQLRestServerDB.Create(Model,':memory:',false); // authentication=false
   try
    aRestServer.CreateMissingTables; // create tables or fields if missing
    // serve aRestServer data over HTTP
    aHttpServer := TSQLHttpServer.Create(SERVER_PORT,[aRestServer],'+',useHttpApiRegisteringURI);
    try
     aHttpServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
     writeln('Background server is running.'#10);
     write('Press [Enter] to close the server.');
     readln;
    finally aHttpServer.Free; end;
   finally aRestServer.Free; end;
  finally Model.Free; end;

end.

Client:

program RESTclient;

{$APPTYPE CONSOLE}

uses
  SynCommons,          // framework core
  mORMot,              // RESTful server & ORM
  mORMotHttpClient;    // HTTP client to a mORMot RESTful server

const
  SERVER_ROOT = 'root';
  SERVER_PORT = '888';

type
 TSQLORM = class(TSQLRecord)
  private
    fAge: integer;
    fName: RawUTF8;
    fDate: TDateTime;
    fValue: variant;
    fInts: TIntegerDynArray;
    fCreateTime: TCreateTime;
    fData: TSQLRawBlob;
  published
    property Name: RawUTF8 read fName write fName stored AS_UNIQUE;
    property Age: integer read fAge write fAge;
    property Date: TDateTime read fDate write fDate;
    property Value: variant read fValue write fValue;
    property Ints: TIntegerDynArray index 1 read fInts write fInts;
    property Data: TSQLRawBlob read fData write fData;
    property CreateTime: TCreateTime read fCreateTime write fCreateTime;
  end;

function DataModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLORM],SERVER_ROOT);
  TSQLORM.AddFilterOrValidate('Name',TSynValidateText.Create); // ensure exists
end;


var aModel: TSQLModel;
    aClient: TSQLHttpClient;
    aSQLORM: TSQLORM;
    aID: integer;
begin
  aModel := DataModel;
  try
    aClient := TSQLHttpClientWinHTTP.Create('localhost',SERVER_PORT,aModel);
    try
      writeln('Add a new TSQLORM');
      aSQLORM := TSQLORM.Create;
      try
        Randomize;
        aSQLORM.Name := 'Name'+Int32ToUtf8(Random(10000));
        aID := aClient.Add(aSQLORM,true);
      finally aSQLORM.Free; end;
      writeln('Added TSQLORM.ID=',aID);

      aSQLORM := TSQLORM.Create(aClient,aID);
      try
        writeln('Name read for ID=',aSQLORM.ID,' from DB = "',aSQLORM.Name,'"');
      finally aSQLORM.Free; end;
    finally aClient.Free; end;
    write(#10'Press [Enter] to quit');
    readln;
  finally aModel.Free; end;
end.

client response:
Add a new TSQLORM
Added TSQLORM.ID=1
Name read for ID=1 from DB = "Name4488"

Press [Enter] to quit

It works, but nothing in mongodb.
In memory table only I think.

this is server log:
20140920 10301428 + TSQLRestServerDB(006D89F0).005892C0
20140920 10301428 call TSQLRestServerDB(006D89F0) TimeStamp
20140920 10301428 srvr TSQLRestServerDB(006D89F0) GET TimeStamp -> 200
20140920 10301428 - 00.002.355
20140920 10301428 + TSQLRestServerDB(006D89F0).005892C0
20140920 10301428 SQL TSQLRestServerDB(006D89F0) INSERT INTO ORM (Name,Age,Date,Value,Ints,CreateTime) VALUES (:('Name4488'):,:(0):,:(''):,:(null):,:('?BAAA'):,:(135193331598):); prepared with 6 params
20140920 10301428 DB TSQLDatabase(007CC338) LastInsertRowID=1
20140920 10301428 srvr TSQLRestServerDB(006D89F0) POST ORM -> 201
20140920 10301428 - 00.002.421
20140920 10301428 + TSQLRestServerDB(006D89F0).005892C0
20140920 10301428 cache TSQLDatabase(007CC338) not in cache
20140920 10301429 SQL TSQLRestServerDB(006D89F0) SELECT ID,Name,Age,Date,Value,Ints,CreateTime FROM ORM WHERE RowID=:(1):; prepared with 1 param
20140920 10301429 res TSQLDatabase(007CC338) [{"ID":1,"Name":"Name4488","Age":0,"Date":null,"Value":null,"Ints":"?BAAA","CreateTime":135193331598}]
20140920 10301429 srvr TSQLRestServerDB(006D89F0) GET ORM -> 200
20140920 10301429 - 00.002.815

Sabbiolina · mORMot 1

Which section are you referring to?

I wrote this:

  MongoClient := TMongoClient.Create('localhost',27017);
  DB := MongoClient.Database['testODM'];
  Model := TSQLModel.Create([TSQLORM]);
  Client := TSQLRestClientDB.Create(Model,nil,':memory:',TSQLRestServerDB);
  if StaticMongoDBRegister(TSQLORM,Client.Server,DB,'mytestcollection')=nil then
  begin
   writeln('Error !'#10);
   exit;
  end;

  try
   // create the main mORMot server
   aRestServer := TSQLRestServerDB.Create(Model,':memory:',false); // authentication=false
   try
    aRestServer.CreateMissingTables; // create tables or fields if missing
    // serve aRestServer data over HTTP
    aHttpServer := TSQLHttpServer.Create(SERVER_PORT,[aRestServer],'+',useHttpApiRegisteringURI);
    try
     aHttpServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
     writeln('Background server is running.'#10);
     write('Press [Enter] to close the server.');
     readln;
    finally aHttpServer.Free; end;
   finally aRestServer.Free; end;
  finally Model.Free; end;

The Db and the collection are written in mongodb regularly, but "CreateMissingTables" does nothing, since there is a link between the aRestServer and MongoDB.

In fact, I was wondering how to do it.
VirtualTableExternalRegisterAll has TSQLDBConnectionProperties as a parameter, but that, looking SAD document is not related to mongodb.

So how to link?

Sabbiolina · mORMot 1

Hi AB, I'm trying to modify the sample 28 to use MongoDB as the database.

I do not know how to convert this function: VirtualTableExternalRegisterAll (Model, aProps);

Or is there another method?

Thanks

Sabbiolina · mORMot 1

For now I have no working example, but I'm working

Sabbiolina · mORMot 1

Even Android

Sabbiolina · mORMot 1

Hi AB,
What do you think of adding Oauth 2 as the authentication server side?

Sabbiolina · mORMot 1

Works well.

Thanks

Sabbiolina · mORMot 1

The rest server now seems stable.

I forgot to upload the .map .....

Sabbiolina · mORMot 1

Now I'm trying

But the .map must be included or separate from exe?

Sabbiolina · mORMot 1

more log:

20140829 19165930 call  	TSQLRestServerFullMemory(0359C770) Auth
20140829 19165930 auth  	TAuthSession(036395A0) New "User" session User/2121733791 created at 88.xxx.226.167/DD00000060000991 running Mozilla/3.0 (compatible; Indy Library)
20140829 19165930 srvr  	TSQLRestServerFullMemory(0359C770) GET auth -> 200
20140829 19165930  -    00.000.128
20140829 19165952  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 19165952 auth  	TSQLRestRoutingREST(035B9450) User/2121733791
20140829 19165952 call  	TSQLRestServerFullMemory(0359C770) restSVR._contract_
20140829 19165952 srvr  	TSQLRestServerFullMemory(0359C770) POST restSVR._contract_ -> 200
20140829 19165952  -    00.000.030
20140829 19165954  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 19165954 auth  	TSQLRestRoutingREST(035B9450) User/2121733788
20140829 19165954 call  	TSQLRestServerFullMemory(0359C770) Auth
20140829 19165954 auth  	TSQLRestServerFullMemory(0359C770) Deleted session User/2121733788 from 88.xxx.226.167/EE00000060003761
20140829 19165954 srvr  	TSQLRestServerFullMemory(0359C770) GET auth -> 200
20140829 19165954  -    00.000.035
20140829 19170015  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 19170015 auth  	TSQLRestRoutingREST(035B9450) User/2121733791
20140829 19170015 call  	TSQLRestServerFullMemory(0359C770) restSVR.func1Back
20140829 19170015 srvr  	TSQLRestServerFullMemory(0359C770) POST restSVR.func1Back -> 200
20140829 19170015  -    00.000.873
20140829 19170155  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 19170155 auth  	TSQLRestRoutingREST(035B9450) User/2121733791
20140829 19170155 call  	TSQLRestServerFullMemory(0359C770) restSVR.func1
20140829 19170155 srvr  	TSQLRestServerFullMemory(0359C770) POST restSVR.func1-> 200
20140829 19170155  -    00.000.960
20140829 19170256  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 19170256 auth  	TSQLRestRoutingREST(035B9450) User/2121733791
20140829 19170256 call  	TSQLRestServerFullMemory(0359C770) restSVR.func1
20140829 19170256 srvr  	TSQLRestServerFullMemory(0359C770) POST restSVR.func1-> 200
20140829 19170256  -    00.001.012
20140829 19170504  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 19170504 auth  	TSQLRestRoutingREST(035B9450) User/2121733791
20140829 19170504 call  	TSQLRestServerFullMemory(0359C770) restSVR.func2
20140829 19170540 srvr  	TSQLRestServerFullMemory(0359C770) POST restSVR.func2 -> 200
20140829 19170540  -    00.581.775
20140829 20284825  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284825 call  	TSQLRestServerFullMemory(0359C770) TimeStamp
20140829 20284825 srvr  	TSQLRestServerFullMemory(0359C770) GET TimeStamp -> 200
20140829 20284825  -    00.000.033
20140829 20284827  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284827 call  	TSQLRestServerFullMemory(0359C770) Auth
20140829 20284827 srvr  	TSQLRestServerFullMemory(0359C770) GET auth -> 200
20140829 20284827  -    00.000.033
20140829 20284829  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284829 call  	TSQLRestServerFullMemory(0359C770) Auth
20140829 20284829 auth  	TAuthSession(03639330) New "User" session User/2121733790 created at 88.xxx.226.167/DD000000600009EB running Mozilla/3.0 (compatible; Indy Library)
20140829 20284829 srvr  	TSQLRestServerFullMemory(0359C770) GET auth -> 200
20140829 20284829  -    00.000.197

I noticed:
20140829 19165930 auth TAuthSession(036395A0) New "User" session User/2121733791 created at 88.xxx.226.167/DD00000060000991
20140829 20284829 auth TAuthSession(03639330) New "User" session User/2121733790 created at 88.xxx.226.167/DD000000600009E

2121733791 before 2121733790 ?

I think:
20140829 19165952 call TSQLRestServerFullMemory(0359C770) restSVR._contract_
20140829 19165952 srvr TSQLRestServerFullMemory(0359C770) POST restSVR._contract_ -> 200

could be the point of the exception

Sabbiolina · mORMot 1

Hi AB

My test server hangs on new connections:

20140829 20284825  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284825 call  	TSQLRestServerFullMemory(0359C770) TimeStamp
20140829 20284825 srvr  	TSQLRestServerFullMemory(0359C770) GET TimeStamp -> 200
20140829 20284825  -    00.000.033
20140829 20284827  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284827 call  	TSQLRestServerFullMemory(0359C770) Auth
20140829 20284827 srvr  	TSQLRestServerFullMemory(0359C770) GET auth -> 200
20140829 20284827  -    00.000.033
20140829 20284829  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284829 call  	TSQLRestServerFullMemory(0359C770) Auth
20140829 20284829 auth  	TAuthSession(03639330) New "User" session User/2121733790 created at 88.xxx.226.167/DD000000600009EB running Mozilla/3.0 (compatible; Indy Library)
20140829 20284829 srvr  	TSQLRestServerFullMemory(0359C770) GET auth -> 200
20140829 20284829  -    00.000.197
20140829 20284849  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284849 EXCOS 	EAccessViolation (C0000005) at 00869889  stack trace 0045A7CD 00408A06 75E733CA 778F9ED2 778F9EA5 
20140829 20284849  -    00.000.700
20140829 20284907  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284907 EXCOS 	EAccessViolation (C0000005) at 00869889  stack trace 0045A7CD 00408A06 75E733CA 778F9ED2 778F9EA5 
20140829 20284907  -    00.000.330
20140829 20284926  +    TSQLRestServerFullMemory(0359C770).00868C04 
20140829 20284926 EXCOS 	EAccessViolation (C0000005) at 00869889  stack trace 0045A7CD 00408A06 75E733CA 778F9ED2 778F9EA5 
20140829 20284926  -    00.000.565

I have already compiled the project with MAP detailed options.
This log does not help me.
The only thing I'm sure of is that the call does not come to my function.

I start with this:

  //mormot
  // define the log level
   with TSQLLog.Family do
   begin
    Level := LOG_VERBOSE;
//    EchoToConsole := LOG_VERBOSE; // log all events to the console
   end;
    TSQLLog.Enter;

   // create a Data Model
   aModel := TSQLModel.Create([],ROOT_NAME);

   try
    // initialize a TObjectList-based database engine
    aServer := TSQLRestServerFullMemory.Create(aModel,'test.json',false,true);
    try


      AddToServerWrapperMethod(aServer,
        ['c:\CrossPlatform\templates','c:\CrossPlatform\templates']);


      // register our Irestsrv service on the server side
     aServer.ServiceRegister(TServiceRestSrv,[TypeInfo(IrestSRV)],sicShared);


     // launch the HTTP server
     aHTTPServer := TSQLHttpServer.Create(PORT_NAME,[aServer],'+',useHttpApiRegisteringURI);
     try
       aHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to wor

     except
     end;
    finally

any ideas ?

ps exe runs on win2008 R2 / xe2
client android

Sabbiolina · mORMot 1

you are rigth

sorry

Sabbiolina · mORMot 1

Unfortunately, the result is the same:

    function list(const tag: stringout tagList: TTagList): string;

from:

  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FF}']
    function Add(n1,n2: integer): integer;
    function list(tag:string;out tagList:TTaglist):string;
  end;

I send the project for testing in mail

Sabbiolina · mORMot 1

HI AB,
there is probably a problem of synchronization in the nightlyBuild.
the mormot.pas is out of date

http://synopse.info/fossil/artifact/946 … 3c1bfee2bb size: 1.652.524
in nightlyBuild size: 1.652.402

Sabbiolina · mORMot 1

Look at this:

server:
  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FF}']
    function Add(n1,n2: integer): integer;
    function list(tag:string;var tagList:TTaglist):string;
  end;


generated:

type
  /// service implemented by TServiceCalculator
  // - you can access this service as such:
  // !var aCalculator: ICalculator;
  // !begin
  // !   aCalculator := TCalculator.Create(aClient);
  // !   // now you can use aCalculator methods
  // !...
  ICalculator = interface(IServiceAbstract)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FF}']
    function Add(const n1: integer; const n2: integer): integer;
    function list(const tag: string; var tagList: TTagList): string;
  end;

----------------

Change VAR in OUT and...

server:
  TServiceCalculator = class(TInterfacedObject, ICalculator)
  public
    function Add(n1,n2: integer): integer;
    function list(tag:string;out tagList:TTaglist):string;
  end;


generated
type
  /// service implemented by TServiceCalculator
  // - you can access this service as such:
  // !var aCalculator: ICalculator;
  // !begin
  // !   aCalculator := TCalculator.Create(aClient);
  // !   // now you can use aCalculator methods
  // !...
  ICalculator = interface(IServiceAbstract)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FF}']
    function Add(const n1: integer; const n2: integer): integer;
    function list(const tag: stringout tagList: TTagList): string; //<-------------------------------------- lost ;
  end;

tested with xe2 e xe6upd1

obviously adding ";" everything works

Sabbiolina · mORMot 1

Is there any way to transfer binary parameters without using base64 encoding?

Thanks

Sabbiolina · mORMot 1

You are magic

Sabbiolina · mORMot 1

Hi AB.

how do I know who is making a call within an interface member?

Let me explain:

TServiceCalculator.Add function (n1, n2: integer): integer;
begin

   // HERE!. Log ip, username of caller


   result: = n1 + n2;
end;

Thanks

Sabbiolina · mORMot 1

Thanks!
Now it works on Android.

Sabbiolina · mORMot 1

WideString was a test

without RegisterCustomJSONSerializerFromText there is a bug in mORMotClient.pas:

type // define some record types, used as properties below
  TTagList = record
    Base: string;
    age: integer;
    L: array of :TTagList.:1;  // <--------------------------------------------
  end;

this is generated unit:

using:
const
__TTagList='base String age integer L [fname string fsize integer]';

initialization
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TTagList),__TTagList);

/// remote access to a mORMot server using SynCrossPlatform* units
// - retrieved from http://localhost:888/root/wrapper/CrossPlatform/mORMotClient.pas.txt
// at 2014-08-21 15:38:12 using "CrossPlatform.pas.mustache" template
unit mORMotClient;

{
  WARNING:
    This unit has been generated by a mORMot 1.18 server.
    Any manual modification of this file may be lost after regeneration.

  Synopse mORMot framework. Copyright (C) 2014 Arnaud Bouchez
    Synopse Informatique - http://synopse.info

  This unit is released under a MPL/GPL/LGPL tri-license,
  and therefore may be freely included in any application.

  This unit would work on Delphi 6 and later, under all supported platforms
  (including MacOSX, and NextGen iPhone/iPad), and the Free Pascal Compiler.
}

interface

uses
  SynCrossPlatformJSON,
  SynCrossPlatformSpecific,
  SynCrossPlatformREST;
  

type // define some record types, used as properties below
  TTagList = record
    base: string;
    age: integer;
    L: array of record
      fname: string;
      fsize: integer;
    end;
  end;


type
  /// service implemented by TServiceCalculator
  // - you can access this service as such:
  // !var aCalculator: ICalculator;
  // !begin
  // !   aCalculator := TCalculator.Create(aClient);
  // !   // now you can use aCalculator methods
  // !...
  ICalculator = interface(IServiceAbstract)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FF}']
    function Add(const n1: integer; const n2: integer): integer;
    function list(const tag: string; var tagList: TTagList): string;
  end;

  /// implements ICalculator from http://localhost:888/root/Calculator
  // - this service will run in sicShared mode
  TServiceCalculator = class(TServiceClientAbstract,ICalculator)
  public
    constructor Create(aClient: TSQLRestClientURI); override;
    function Add(const n1: integer; const n2: integer): integer;
    function list(const tag: string; var tagList: TTagList): string;
  end;

const
  /// the server port, corresponding to http://localhost:888
  SERVER_PORT = 888;


/// return the database Model corresponding to this server
function GetModel: TSQLModel;

/// create a TSQLRestClientHTTP instance and connect to the server
// - it will use by default port 888
// - secure connection will be established via TSQLRestServerAuthenticationDefault
// with the supplied credentials - on connection or authentication error,
// this function will raise a corresponding exception
function GetClient(const aServerAddress, aUserName,aPassword: string;
  aServerPort: integer=SERVER_PORT): TSQLRestClientHTTP;


implementation


{ Some helpers for record types }

function Variant2TTagList(const _variant: variant): TTagList;
var _a: integer;
    _arr: PJSONVariantData;
begin
  result.base := _variant.base;
  result.age := _variant.age;
  _arr := JSONVariantDataSafe(_variant.L,jvArray);
  SetLength(result.L,_arr^.Count);
  for _a := 0 to high(result.L) do
  with result.L[_a] do begin
    fname := _arr^.Values[_a].fname;
    fsize := _arr^.Values[_a].fsize;
  end;
end;

function TTagList2Variant(const _record: TTagList): variant;
var i: integer;
    res: TJSONVariantData;
begin
  res.Init;
  res.SetPath('base',_record.base);
  res.SetPath('age',_record.age);
  with res.EnsureData('L')^ do
    for i := 0 to high(_record.L) do
    with AddItem^, _record.L[i] do begin
      AddNameValue('fname',fname);
      AddNameValue('fsize',fsize);
    end;
  result := variant(res);
end;

function GetModel: TSQLModel;
begin
  result := TSQLModel.Create([TSQLAuthUser,TSQLAuthGroup],'root');
end;

function GetClient(const aServerAddress, aUserName,aPassword: string;
  aServerPort: integer): TSQLRestClientHTTP;
begin
  result := TSQLRestClientHTTP.Create(aServerAddress,aServerPort,GetModel,true); // aOwnModel=true
  try
    if (not result.Connect) or (result.ServerTimeStamp=0) then
      raise ERestException.CreateFmt('Impossible to connect to %s:%d server',
        [aServerAddress,aServerPort]);
    if not result.SetUser(TSQLRestServerAuthenticationDefault,aUserName,aPassword) then 
      raise ERestException.CreateFmt('%s:%d server rejected "%s" credentials',
        [aServerAddress,aServerPort,aUserName]);
  except
    result.Free;
    raise;
  end;
end;


{ TServiceCalculator }

constructor TServiceCalculator.Create(aClient: TSQLRestClientURI);
begin
  fServiceName := 'Calculator';
  fServiceURI := 'Calculator';
  fInstanceImplementation := sicShared;
  fContractExpected := '402490DC946DB090';
  inherited Create(aClient);
end;

function TServiceCalculator.Add(const n1: integer; const n2: integer): integer;
var res: TVariantDynArray;
begin
  fClient.CallRemoteService(self,'Add',1, // raise EServiceException on error
    [n1,n2],res);
  Result := res[0];
end;

function TServiceCalculator.list(const tag: string; var tagList: TTagList): string;
var res: TVariantDynArray;
begin
  fClient.CallRemoteService(self,'list',2, // raise EServiceException on error
    [tag,TTagList2Variant(tagList)],res);
  tagList := Variant2TTagList(res[0]);
  Result := res[1];
end;


end.

I download night mormot every day

Sabbiolina · mORMot 1

hello AB.

unit Project14Interface;

interface

uses
  SynCommons,
  mORMot,
  mORMotHttpServer,
  mORMotWrappers,
  SynMustache,
  SysUtils;

type
  TTagList = packed record
    Base: widestring;
    age:integer;
    L: array of packed record
     fname: WideString;
     fsize: integer;
    end;
  end;

  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FF}']
    function Add(n1,n2: integer): integer;
    function list(tag:string;var tagList:TTaglist):string;
  end;

  TServiceCalculator = class(TInterfacedObject, ICalculator)
  public
    function Add(n1,n2: integer): integer;
    function list(tag:string;var tagList:TTaglist):string;
  end;
const
  ROOT_NAME = 'root';
  PORT_NAME = '888';
  APPLICATION_NAME = 'RestService';

implementation

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

function TServiceCalculator.list(tag:string;var tagList:TTaglist):string;
begin
  result := UTF8ToString(RecordSaveJSON(tagList,TypeInfo(TTagList)));

  tagList.Base:='Test';
  tagList.age:=10;

(* remove comment to work

  setlength(tagList.L,2);
  tagList.L[0].fname:='name1';
  tagList.L[0].fsize:=10;
  tagList.L[1].fname:='name2';
  tagList.L[1].fsize:=20;

 remove comment to work *)
end;

const
  __TTagList='base WideString age integer L [fname widestring fsize integer]';

initialization
  TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TTagList),__TTagList);

end.

I was able to communicate with the server (win32) and client (android) and to return a complex structure with an array in it.

But, probably because of my mistake, I noticed that if the array is empty the appicazione returns this error:
Error calling calculator.list - received 0 parameters (expected 2)

Return the error also filling in for FMX.win32

I'm using Xe6upd1 with the last mORMot.

Sabbiolina · mORMot 1

I'm looking for the right way to get a list of records from a call.

Sabbiolina · mORMot 1

but..... this code is not generated?

{$ifdef TESTRECORD}

{ TSQLRecordPeople }

const
  __TTestCustomJSONArraySimpleArray =
  'F RawUTF8 G array of RawUTF8 '+
  'H {H1 integer H2 WideString H3{H3a boolean H3b RawByteString}} I TDateTime '+
  'J [J1 byte J2 TGUID J3 TRecordEnum]';

class procedure TSQLRecordPeople.InternalRegisterCustomProperties(
  Props: TSQLRecordProperties);
begin
  Props.RegisterCustomPropertyFromRTTI(Self,TypeInfo(TTestCustomJSONArraySimpleArray),
    'Simple',@TSQLRecordPeople(nil).fSimple);
end;

initialization
  TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TRecordEnum));
  TTextWriter.RegisterCustomJSONSerializerFromText(
    TypeInfo(TTestCustomJSONArraySimpleArray),__TTestCustomJSONArraySimpleArray);

{$endif TESTRECORD}

mORMot Open Source

#51 Re: mORMot 1 » Need advice how to improve security » 2014-11-02 14:54:11

#52 Re: mORMot 1 » [mongodb] Replicaset » 2014-10-08 18:18:45

#53 Re: mORMot 1 » How mORMot access mutl database? » 2014-10-03 15:54:17

#54 Re: mORMot 1 » [mongodb] Replicaset missing type 17 (betTimeStamp) » 2014-10-02 09:47:19

#55 Re: mORMot 1 » [mongodb] Replicaset missing type 17 (betTimeStamp) » 2014-10-01 22:04:50

#56 Re: mORMot 1 » [mongodb] Replicaset missing type 17 (betTimeStamp) » 2014-10-01 21:33:08

#57 Re: mORMot 1 » [mongodb] Replicaset missing type 17 (betTimeStamp) » 2014-10-01 19:52:23

#58 mORMot 1 » [mongodb] Replicaset » 2014-09-30 22:38:00

#59 Re: mORMot 1 » [mongodb] Replicaset missing type 17 (betTimeStamp) » 2014-09-30 22:19:23

#60 Re: mORMot 1 » Access to nested array in json » 2014-09-29 21:33:15

#61 Re: mORMot 1 » Access to nested array in json » 2014-09-29 19:51:36

#62 mORMot 1 » Access to nested array in json » 2014-09-29 19:19:42

#63 Re: mORMot 1 » [TSQLAuthUser] disable a user » 2014-09-26 10:01:12

#64 Re: mORMot 1 » CreateMissingTables with MongoDB Enigma » 2014-09-26 08:21:54

#65 Re: mORMot 1 » [TSQLAuthUser] disable a user » 2014-09-26 07:40:20

#66 mORMot 1 » [TSQLAuthUser] disable a user » 2014-09-25 21:31:22

#67 Re: mORMot 1 » CreateMissingTables with MongoDB Enigma » 2014-09-25 11:29:49

#68 Re: mORMot 1 » CreateMissingTables with MongoDB Enigma » 2014-09-25 07:13:48

#69 mORMot 1 » [mongodb] Replicaset missing type 17 (betTimeStamp) » 2014-09-23 12:38:36

#70 mORMot 1 » CreateMissingTables with MongoDB Enigma » 2014-09-22 12:46:48

#71 mORMot 1 » cache related » 2014-09-22 11:49:12

#72 mORMot 1 » Cache on CrossPlatform (client)? » 2014-09-20 21:40:28

#73 mORMot 1 » TSQLRestCache.CachedEntries improvement/safe » 2014-09-20 21:36:25

#74 mORMot 1 » Cache limit » 2014-09-20 21:31:34

#75 Re: mORMot 1 » [mongodb] Sample 28 Conversion » 2014-09-20 14:11:44

#76 Re: mORMot 1 » [mongodb] Sample 28 Conversion » 2014-09-20 13:55:18

#77 Re: mORMot 1 » [mongodb] Sample 28 Conversion » 2014-09-20 09:54:38

#78 Re: mORMot 1 » [mongodb] Sample 28 Conversion » 2014-09-20 08:33:18

#79 Re: mORMot 1 » [mongodb] Sample 28 Conversion » 2014-09-20 07:44:51

#80 mORMot 1 » [mongodb] Sample 28 Conversion » 2014-09-19 21:55:24

#81 Re: mORMot 1 » [AuthenticationScheme] Oauth 2 » 2014-09-17 12:38:20

#82 Re: mORMot 1 » XE7 is out and mORMot works with it » 2014-09-05 13:53:24

#83 mORMot 1 » [AuthenticationScheme] Oauth 2 » 2014-09-03 10:00:47

#84 Re: mORMot 1 » [Interface based Services] Exception » 2014-08-30 19:06:22

#85 Re: mORMot 1 » [Interface based Services] Exception » 2014-08-30 07:15:32

#86 Re: mORMot 1 » [Interface based Services] Exception » 2014-08-29 22:18:23

#87 Re: mORMot 1 » [Interface based Services] Exception » 2014-08-29 19:05:20

#88 mORMot 1 » [Interface based Services] Exception » 2014-08-29 18:42:19

#89 Re: mORMot 1 » [CrossPlatform generator] parameter qualifiers: var / out problem » 2014-08-28 09:00:19

#90 Re: mORMot 1 » [CrossPlatform generator] parameter qualifiers: var / out problem » 2014-08-28 07:36:45

#91 Re: mORMot 1 » [CrossPlatform generator] parameter qualifiers: var / out problem » 2014-08-28 06:52:06

#92 mORMot 1 » [CrossPlatform generator] parameter qualifiers: var / out problem » 2014-08-26 19:54:59

#93 mORMot 1 » [Interface based Services] binary transfert » 2014-08-26 15:42:49

#94 Re: mORMot 1 » [Interface based Services] Internal data » 2014-08-26 07:10:58

#95 mORMot 1 » [Interface based Services] Internal data » 2014-08-25 15:33:28

#96 Re: mORMot 1 » Generates Cross-Platform mORMot Clients » 2014-08-21 15:13:27

#97 Re: mORMot 1 » Generates Cross-Platform mORMot Clients » 2014-08-21 13:43:55

#98 Re: mORMot 1 » Generates Cross-Platform mORMot Clients » 2014-08-21 09:17:10

#99 Re: mORMot 1 » Generates Cross-Platform mORMot Clients » 2014-08-18 21:52:49

#100 Re: mORMot 1 » Generates Cross-Platform mORMot Clients » 2014-08-18 21:20:02

Board footer