Pages: 1 2

#1 Re: mORMot 1 » ISO 8601 to JSON -> No millisecond resolution » 2016-12-30 06:11:33

avista

Thanks.  Hopefully this will get included by default in the near future. smile

#2 mORMot 1 » ISO 8601 to JSON -> No millisecond resolution » 2016-12-30 04:56:34

avista
Replies: 4

I know this has been covered before (e.g., http://synopse.info/forum/viewtopic.php?id=2047), but in my situation I have a datetime field that I'm returning in a JSON representation of a datetime value, where milliseconds is required in the ISO 8601 format.

Is there a reason milliseconds were omitted? 

Is there a way to for me to generically customize the JSON serialization routine to add support for milliseconds for *all* RTTI generic record serializations or do I need to create a customized serialization routine for every record I'm converting to JSON that has this requirement?

Thanks

#3 Re: mORMot 1 » Load Balancing and Session Persistence » 2016-06-13 15:51:42

avista

Thank you for your perspective on this.

The problem is that we need geo-redundancy on the server, so there needs to be a server running in two separate data centers.

If you want something more global, create a global application session, with its own state - but it would be something else than TAuthSession, e.g. some shared data persisted as a TSQLRecord.

That's the path I first tried, but it became obvious that implementing my own user/session management and authentication was more difficult than simply overriding some of the default mORMot behavior.

(e.g., as mentioned here: http://synopse.info/forum/viewtopic.php?id=1474)

And I would not implement it at TAuthSession level, since it would reduce the performance a lot to access an external/centralized database.
...
IMHO load-balancing at IP level is to be used only with stateless requests (e.g. return a static content, or some uncoupled information - see "stateless" in the doc).

We are essentially creating an API for 3rd parties to use to provision our system (via REST URIs), which is using an existing, mature MS SQL Server database with time-tested stored procedures, so we are not in a position to use mORMot as-is.

We do need to maintain state because we have our own security architecture to manage user group rights to various application functions, so I don't know how we'd ever be able to avoid database lookups when authenticating a new user-session.

We do persist those group rights in memory (which we do from a global instance on server startup, with periodic refreshes) otherwise it would definitely affect performance to look them up every time a request was made.  That's why my current implementation (as shown in my RetrieveSession method) first checks to see if the session exists in memory, otherwise it checks the database and creates one for the next call, so I imagine performance shouldn't be affected too much.

Please let me know if I'm missing something else here that would severely impact performance.

The load balancing is usually done within the mORMot server itself, which performs as fast as a proxy (e.g. nginx).

Can you please explain this a bit more?  I'm not clear on what you mean other than that mORMot performance is sufficient to remove the need for load-balanced servers.

I'd also be interested in anything more you can share (relevant links or otherwise) on scaling or load-balancing.  How else would one scale a mORMot system (e.g., like scaling an ASP.NET MVC site, where all subscriber/auth information is also stored in the database).

I suppose we could deploy server instances in to different locations, and just have a primary/secondary DNS in case the first one cannot be accessed, rather than try to save the session state...

In any case, I'm always open to a better/more efficient way of doing things... smile

#4 mORMot 1 » Load Balancing and Session Persistence » 2016-06-13 06:11:04

avista
Replies: 6

Since mORMot stores session information in memory, what is the recommended method of handling multiple instances of a mormot server on different machines for load balancing and/or redundancy?  It seems the signature would constantly change and require a login every time a call to each server instance is made.

For example:
First call --> Server A
Second call --> Server B (requires root/auth login to get new session signature)
Third call --> Server A (session signature was changed above, so call is now rejected from server A)
Etc.

Perhaps I'm missing something obvious, but the only solution I could come up with was to override some of the authentication methods so I could persist the session in a database table.

I also found that for the authentication to work, I had to set fIDCardinal to the signature returned from the database so it matches the one used by the other server instance.

For example:

procedure TMyCustomAuthSession.SetSignature(const aSignature: RawUTF8);
begin
  Assert(Length(aSignature) = 8);
  // set fIDCardinal to the signature returned from the database so it matches the one used by the other server instance
  HexDisplayToCardinal(@aSignature[1], fIDCardinal);
end;


function TMyCustomRestServerAuthentication.RetrieveSession(Ctxt: TSQLRestServerURIContext): TAuthSession;
var
  Svr: TMyRestServer;
  SessionSignature: RawUTF8;
  AuthGroupId: Integer;
  MyAuthUser: TMySQLAuthUser;
  SQLAuthUser: TSQLAuthUser;
  WebServiceSession: TWebServiceSession;
begin
  Result := inherited;
  if (Result = nil) then
  begin
    Svr := (Ctxt.Server as TMyRestServer);
    if UrlDecodeNeedParameters(Ctxt.Parameters, 'session_signature') then
    begin
      SessionSignature := Ctxt.InputUTF8['session_signature'];
      // signature must be 8 bytes
      Assert(Length(SessionSignature) = 8);
      WebServiceSession := nil;
      if Svr.GetDataAccessLayer.LookupUserBySessionSignature(SessionSignature, False, WebServiceSession, MyAuthUser) then
      begin
        try
          if (MinutesBetween(NowUTC, WebServiceSession.LoginDateTime) > GetLoginTimeout) then
          begin
            Svr.GetDataAccessLayer.WebServiceSessionDelete(WebServiceSession.WebServiceSessionId);
            AuthUser.Free;
            Result := nil;
          end
          else
          begin
            Svr.GetDataAccessLayer.WebServiceSessionUpdateLoginTime(WebServiceSession.WebServiceSessionId);
            AuthGroupId := Svr.MainFieldID(TSQLAuthGroup, 'Admin');
            MyAuthUser.GroupRights := TSQLAuthGroup(AuthGroupId);
            SQLAuthUser := MyAuthUser;
            Svr.SessionCreate(SQLAuthUser, Ctxt, Result);
            Result.User.GroupRights.SessionTimeout := GetLoginTimeout;
====>(Result as TMyCustomAuthSession).SetSignature(SessionSignature);
          end;
        finally
          WebServiceSession.Free;
        end;
      end;
    end;
  end;
end;

Am I way off base here or does this look like a reasonable solution (it works as implemented).

Thanks

#5 Re: mORMot 1 » JSON Default Serialization Options » 2016-02-27 16:35:08

avista

Fair enough. 

If there's no straightforward way to achieve this then I guess I'll just continue registering every DTO in my project and will deal with the inevitable "PerThread execution failed (probably due to bad input parameters)" error on a case by case basis.

#6 mORMot 1 » JSON Default Serialization Options » 2016-02-26 21:58:08

avista
Replies: 2

When defining JSON serialization options, I currently need to set the options for each record.

For example:

var
  Options: TJSONCustomParserSerializationOptions;
begin
  Options := [soReadIgnoreUnknownFields];
  TTextWriter.RegisterCustomJSONSerializerSetOptions(TypeInfo(TRecord_1), Options, True);
  TTextWriter.RegisterCustomJSONSerializerSetOptions(TypeInfo(TRecord_2), Options, True);
  TTextWriter.RegisterCustomJSONSerializerSetOptions(TypeInfo(TRecord_3), Options, True);
end;

However, if I forget to register a new record, then I invariably run into parsing problems when the users of my REST service include unknown fields.

So, I created a singleton method to be able to specify default options:

var
  Options: TJSONCustomParserSerializationOptions;
begin
  Options := [soReadIgnoreUnknownFields];
  TJSONRecordAbstract.SetDefaultSerializationOptions(Options);
end;

Would it be possible to include this in the official code?  Here are my proposed changes:

var
  DefaultTextWriterJSONClass: TTextWriterClass = TTextWriter;
  DefaultTextWriterTrimEnum: boolean;
  DefaultSerializationOptions: TJSONCustomParserSerializationOptions; //<----------

class procedure TJSONRecordAbstract.SetDefaultSerializationOptions(aOptions: TJSONCustomParserSerializationOptions);
begin
  DefaultSerializationOptions := aOptions;
end;

function TJSONRecordAbstract.CustomReader(P: PUTF8Char; var aValue; out aValid: Boolean): PUTF8Char;
var Data: PByte;
begin
  Data := @aValue;
  fOptions := fOptions + DefaultSerializationOptions; //<-----------------
  aValid := Root.ReadOneLevel(P,Data,Options);
  result := P;
end;

procedure TJSONRecordAbstract.CustomWriter(const aWriter: TTextWriter; const aValue);
var P: PByte;
begin
  P := @aValue;
  fOptions := fOptions + DefaultSerializationOptions; //<-----------------
  Root.WriteOneLevel(aWriter,P,Options);
end;

Perhaps there is a better/cleaner way to achieve this, but this was the only way I could find to get it to work.

Thanks

#7 Re: mORMot 1 » JSON Parser Bug - Enumerated Types » 2016-01-26 18:34:15

avista
ab wrote:

Why did you disable EnumSetsAsText=false for logging?

That was unintentional.  I just meant to disable the prefix trimming. smile

Thank you for the updates!

#8 mORMot 1 » JSON Parser Bug - Enumerated Types » 2016-01-25 20:03:58

avista
Replies: 7

I found a problem where, if the 'twoEnumSetsAsTextInRecord' option is enabled, deserializing fails.

The problem is in TTextWriter.AddTypedJSON(), where the lowercase prefix of the enumerated type name is being stripped:

procedure TTextWriter.AddTypedJSON(aTypeInfo: pointer; const aValue;
  EnumSetsAsText,FullSetsAsStar: boolean);
var max, i: Integer;
    PS: PShortString;
begin
  case PTypeKind(aTypeInfo)^ of
    tkClass:
      WriteObject(TObject(aValue),[woFullExpand]);
    tkEnumeration:
      if EnumSetsAsText then begin
        Add('"');
        AddTrimLeftLowerCase(GetEnumName(aTypeInfo,byte(aValue))); <<<<<<<<<<<<<<<<
        Add('"');
      end else
        AddU(byte(aValue));

And when it's being read, it's assuming the lowercase prefix is NOT present:

function TJSONCustomParserCustomSimple.CustomReader(P: PUTF8Char;
  var aValue; out EndOfObject: AnsiChar): PUTF8Char;
[...]
    ktEnumeration: begin
      if wasString then
        i32 := GetEnumNameValue(fCustomTypeInfo,PropValue,StrLen(PropValue)) else <<<<<<<<<<<<<<<
        i32 := GetCardinal(PropValue);
      if i32<0 then
[...]

It should be:

        i32 := GetEnumNameValue(fCustomTypeInfo,PropValue,StrLen(PropValue), TRUE) else

Logging is making the opposite assumption:

procedure TSynLog.LogInternal(Level: TSynLogInfo; const aName: RawUTF8;
   aTypeInfo: pointer; var aValue; Instance: TObject=nil);
begin
  if LogHeaderLock(Level,false) then
  try
    if Instance<>nil then
      fWriter.AddInstancePointer(Instance,' ',fFamily.WithUnitName);
    fWriter.AddFieldName(aName);
    fWriter.AddTypedJSON(aTypeInfo,aValue,true,true); <<<<<<<<<<<<<<<<<<
  finally
    LogTrailerUnLock(Level);
  end;
end;

HOWEVER, IMO the lowercase prefix shouldn't be trimmed in the first place, unless there is a corresponding option when de-serializing to specify whether or not the prefix is expected.

Therefore, because this looks like it has been broken for a long time (and unless I'm missing some other use cases), I propose that the prefix NOT be trimmed, as this is assuming everybody wants their enumerated types stripped of the prefix:

procedure TTextWriter.AddTypedJSON(aTypeInfo: pointer; const aValue;
  EnumSetsAsText,FullSetsAsStar: boolean);
var max, i: Integer;
    PS: PShortString;
begin
  case PTypeKind(aTypeInfo)^ of
    tkClass:
      WriteObject(TObject(aValue),[woFullExpand]);
    tkEnumeration:
      if EnumSetsAsText then begin
        Add('"');
        AddShort(GetEnumName(aTypeInfo,byte(aValue))^); <<<<<<<<<<<<<<<<
        Add('"');
      end else
        AddU(byte(aValue));

In my case, I want the enumerated type names *unmodified*, with the prefix left intact.

(Of course, the logging would need to change too)

procedure TSynLog.LogInternal(Level: TSynLogInfo; const aName: RawUTF8;
   aTypeInfo: pointer; var aValue; Instance: TObject=nil);
begin
  if LogHeaderLock(Level,false) then
  try
    if Instance<>nil then
      fWriter.AddInstancePointer(Instance,' ',fFamily.WithUnitName);
    fWriter.AddFieldName(aName);
    fWriter.AddTypedJSON(aTypeInfo,aValue,false,true); <<<<<<<<<<<<<<
  finally
    LogTrailerUnLock(Level);
  end;
end;

Thanks

#9 mORMot 1 » JSON Parser Bug » 2016-01-19 20:26:48

avista
Replies: 1

In TJSONCustomParserRTTI.ReadOneLevel():

(Using the nightly build dated 2016-01-16)

    ptCustom:
      P := TJSONCustomParserCustom(Prop).CustomReader(P,Data^,EndOfObject);

Needs to be:

    ptCustom: begin
      P := TJSONCustomParserCustom(Prop).CustomReader(P,Data^,EndOfObject);
      if P=nil then
       exit;
    end;

Otherwise the parsing continues and data corruption can occur.

I'm using this with RecordLoadJSON() and the problem happened in a nested record, when an integer was expected, but a string value was specified.

Currently, RecordLoadJSON() returns nil if the JSON was not valid, but it would be incredibly helpful if there was a way to validate the JSON against the record/object it's being de-serialzed to, so that I can see exactly where the parsing failed, instead of having to hunt through some large JSON strings (especially with nested objects and arrays) to find the offending syntax or type mismatch. It's like hunting for a needle in a haystack. smile

Even having a separate function to perform this kind of validation would be extremely useful!

#10 Re: mORMot 1 » Exception when converting record with extended type to JSON » 2015-12-01 05:12:16

avista

Thanks!

#11 mORMot 1 » Exception when converting record with extended type to JSON » 2015-11-25 04:45:53

avista
Replies: 2

I'm getting an exception when trying to serialize a record with an extended type to JSON:

type
  TMyRecord = packed record
    Value: Extended;
  end;

var
  MyRec: TMyRecord;
  json: RawUTF8;
begin
  MyRec.Value := 12.34;
  json := RecordSaveJSON(MyRec, TypeInfo(TMyRecord));
end.

Exception: TJSONCustomParserRTTI.CreateFromRTTI("EXTENDED")

This occurs in SynCommons.pas in class function TJSONCustomParserRTTI.CreateFromRTTI():

class function TJSONCustomParserRTTI.CreateFromRTTI(
  const PropertyName: RawUTF8; Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
var Item: PDynArrayTypeInfo absolute Info;
    ItemType: TJSONCustomParserRTTIType;
    ItemTypeName: RawUTF8;
    ndx: integer;
begin
  if Item=nil then // no RTTI -> stored as hexa string
    result := TJSONCustomParserCustomSimple.CreateFixedArray(PropertyName,ItemSize) else begin
    ItemType := TypeNameToSimpleRTTIType(PUTF8Char(@Item.NameLen)+1,Item.NameLen,ItemTypeName);
    if ItemType=ptCustom then
      ItemType := TypeInfoToSimpleRTTIType(Info,ItemSize);
    if ItemType=ptCustom then
      if Item^.kind in [tkEnumeration,tkArray,tkDynArray] then
        result := TJSONCustomParserCustomSimple.Create(
          PropertyName,ItemTypeName,Item) else begin
        ndx := GlobalJSONCustomParsers.RecordSearch(Item);
        if ndx<0 then
          ndx := GlobalJSONCustomParsers.RecordSearch(ItemTypeName);
        if ndx<0 then
          raise ESynException.CreateUTF8('%.CreateFromRTTI("%")',  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
            [self,ItemTypeName]);
        result := TJSONCustomParserCustomRecord.Create(PropertyName,ndx);
      end else
      result := TJSONCustomParserRTTI.Create(PropertyName,ItemType);
  end;
  if ItemSize<>0 then
    result.fDataSize := ItemSize;
end;

We need the extended precision, because the number stored in the database has a precision that requires the extended type: SQL Server: decimal(21, 10)

Thanks!

#12 Re: mORMot 1 » How to Return Empy Content with TServiceCustomAnswer? » 2015-10-31 17:14:10

avista

Setting the Header to TEXT_CONTENT_TYPE_HEADER solved the problem smile : 

function TMyService.UploadFile: TServiceCustomAnswer;
begin
  DoGetFileData(ServiceContext.Request);
  Result.Header := TEXT_CONTENT_TYPE_HEADER; <============
  Result.Content := '';
  Result.Status := HTML_SUCCESS;
end;

#13 mORMot 1 » How to Return Empy Content with TServiceCustomAnswer? » 2015-10-30 18:53:27

avista
Replies: 1

In general, I'm using TServiceCustomAnswer to return content from my interface based service.

However, there are some cases where I don't want to return any content (i.e., after submitting form data). 

If I set Content to an empty string, the default JSON response is still returned:

My Code (Interface Based)

function TMyService.UploadFile: TServiceCustomAnswer;
begin
  DoGetFileData(ServiceContext.Request);
  Result.Header := '';
  Result.Content := '';
  Result.Status := HTML_SUCCESS;
end;

Response Header (Interface Based)

HTTP/1.1 200 OK
Content-Type: application/json; charset=UTF-8
Server: mORMot/1.18.2017 (Windows) Microsoft-HTTPAPI/2.0
X-Powered-By: Synopse mORMot 1.18.2017 http://synopse.info
Server-InternalState: 14
Accept-Encoding: synlz,gzip
Date: Fri, 30 Oct 2015 18:31:23 GMT
Content-Length: 64

Response Body

{"result":[{"Header":"","Content":null,"Status":200}],"id":5692}

What I need is to be able to specify a return status with EMPTY content.  The same code I use in a method based service returns the following:

My Code (Method Based)

function TMyServer.UploadFile(Ctxt: TSQLRestServerURIContext);
begin
  DoGetFileData(Ctxt);
  Ctxt.Success;
end;

Response Header

HTTP/1.1 200 OK
Server: mORMot/1.18.2017 (Windows) Microsoft-HTTPAPI/2.0
X-Powered-By: Synopse mORMot 1.18.2017 http://synopse.info
Server-InternalState: 14
Accept-Encoding: synlz,gzip
Date: Fri, 30 Oct 2015 18:29:44 GMT
Content-Length: 0

This is the behavior I'm looking for.  Is there a way to ensure that no content is returned when setting TServiceCustomAnswer.Content to an empty string?

(And to be clear, I want to use the interface-based service because there is other supporting code in that class for many functions, including database access, that I don't want to duplicate)

:)

Thanks!

#14 mORMot 1 » Custom Authentication For Two REST Server Instances » 2015-06-30 17:40:29

avista
Replies: 1

I have two servers based on TSQLRestServerFullMemory.

One is interface based, and one is method based. 

I've implemented a custom authentication scheme to get data from an existing database.

The problem I'm encountering is that when registering these two servers, it's mandatory that I use a different Root URI for each one.  That's fine, however I want to share the authentication session between the two server instances.  The reason I'm using the method based service in addition to the interface based one is that I need to provide download services for binary file data, and only the method based service supports that. This is also a problem if I want to create additional services for different sub-domains, for purposes of modularity, since I'd also need to authenticate each URI separately, which is problematic. (e.g., 'root/myservice', 'root/myservice/fileservices', 'root/myservice/otherservices').

Is there a way to authenticate once, regardless of server instance/root URI, and then re-use that instance (by using the same signature) for for calling these services, instead of having to authenticate separately and initiate a separate auth session for each server instance?  Or do I need to put everything in a single method based server instance and handle all of the URI parsing in that service?

Thanks,
Doug

#15 Re: mORMot 1 » TSQLRestServerURIContext.Error() virtual? » 2015-04-22 01:02:47

avista

Thanks Arnaud!

#16 mORMot 1 » TSQLRestServerURIContext.Error() virtual? » 2015-04-21 20:38:24

avista
Replies: 2

Would it be possible to make the following method in mORMot.pas virtual on a go-forward basis?  

  procedure Error(const ErrorMessage: RawUTF8 = ''; Status: integer = HTML_BADREQUEST);
  overload;
  virtual; <------------

I need to override it to provide a consistent response format.

Thanks!

#17 Re: mORMot 1 » AV in TSQLHttpServer.Create() when port already in use » 2014-10-10 17:10:50

avista

If you run two instances of the Project14ServerHttpWeak application, you will see the issue when the second instance runs.  I just realized that the URL mapping has to be the same for the error to occur, not just the port.  Sorry I didn't make that clear.

Please let me know if you need any further clarification.

#18 Re: mORMot 1 » AV in TSQLHttpServer.Create() when port already in use » 2014-10-07 17:46:01

avista

Done, thanks.

http://synopse.info/fossil/tktview/6354 … 9142a65757

#19 mORMot 1 » AV in TSQLHttpServer.Create() when port already in use » 2014-10-04 01:35:06

avista
Replies: 5

If I attempt to create an instance of the HTTP Server when the port is already in use, I get an AV:

To reproduce this error, I ran another server that binds the same port (8080 in this case), and then ran the Project14ServerHttpWeak project with this same port:

20141003 18173830  +    TSQLHttpServer(008285A8).00515016 
20141003 18174030 EXC   	ECommunicationException ("TSQLHttpServer.Create: Impossible to register URL for root") at 005152E0  stack trace API 0048FA84 
20141003 18174030 ERROR 	TSQLHttpServer(008285A8) {"ECommunicationException":"TSQLHttpServer.Create: Impossible to register URL for root"}{"ECommunicationException(008130C0)":[20141003 18174138 EXCOS 	EAccessViolation (C0000005) at 0047E7B5  stack trace API 0048FA84 00407CC0 76F7B46B 76F30133 0047F936 00492532 00490DA6 0051533C 0051ACCD 76A2338A 76F59F72 76F59F45 
 stack trace API 00490DA6 0051533C 0051ACCD 76A2338A 76F59F72 76F59F45 
20141003 18174139  -    03.139.726
20141003 18174140 EXCOS EAccessViolation (C0000005) at 0047E7B5  stack trace API 0048FA84 0040816E 76F7B46B 76F30133 0047F936 00492532 00490DA6 0051533C 0051ACCD 76A2338A 76F59F72 76F59F45 
20141003 18174140  +    TSQLRestServerFullMemory(00791670).Shutdown
20141003 18174140 info  	CurrentRequestCount=0
20141003 18174140  -    00.004.698
20141003 18174140 info  TSQLRestServerFullMemory.Destroy -> null

The problem occurs when the fHttpServer instance is freed in mORMotHttpServer.pas here:

constructor TSQLHttpServer.Create(const aPort: AnsiString;
  const aServers: array of TSQLRestServer; const aDomainName: AnsiString;
  aHttpServerKind: TSQLHttpServerOptions; ServerThreadPoolCount: Integer;
  aHttpServerSecurity: TSQLHttpServerSecurity);
...
  {$ifndef USETCPPREFIX}
  if aHttpServerKind in [useHttpApi,useHttpApiRegisteringURI] then
  try
    // first try to use fastest http.sys
    fHttpServer := THttpApiServer.Create(false);
    for i := 0 to high(aServers) do begin
      j := THttpApiServer(fHttpServer).AddUrl(
        aServers[i].Model.Root,aPort,(aHttpServerSecurity=secSSL),aDomainName,
        (aHttpServerKind=useHttpApiRegisteringURI));
      if j<>NO_ERROR then begin
        ErrMsg := 'Impossible to register URL';
        if j=ERROR_ACCESS_DENIED then
          ErrMsg := ErrMsg+' (administrator rights needed)';
        raise ECommunicationException.CreateFmt('%s.Create: %s for %s',
          [ClassName,ErrMsg,aServers[i].Model.Root]);
        break;
      end;
    end;
  except
    on E: Exception do begin
      {$ifdef WITHLOG}
      Log.Log(sllError,'% for %',[E,fHttpServer],self);
      {$endif}
      FreeAndNil(fHttpServer); // if http.sys initialization failed <<=================================================
    end;
  end;
  {$endif}
...

Also, the next thing it does is try to create a instance of the pure Delphi server, which will also fail:

  if fHttpServer=nil then begin
    // http.sys failed -> create one instance of our pure Delphi server
    fHttpServer := THttpServer.Create(aPort
      {$ifdef USETHREADPOOL},ServerThreadPoolCount{$endif});
    {$ifdef USETCPPREFIX}
    THttpServer(fHttpServer).TCPPrefix := 'magic';
    {$endif}
  end;

Aside from the error condition being unrecoverable (which is especially problematic for a service application), is there a way to ensure that the 'pure' Delphi server is never used?  I don't want to assume a server is running using the kernel http.sys when it might not be.

Thanks

#20 Re: mORMot 1 » Weak Authentication Failure » 2014-09-10 22:12:24

avista

Conversion to/from decimal/hexa is confusing a developer?

It is when it's not consistent:

- Create session and return a decimal number X
- Authenticate a session and require 'session_signature=' X to be in hexadecimal
- Close a session and require 'session=' to be decimal

This is a number, not a token.

The value that is passed via 'session_signature='/'session=' seems to be a token of sorts, so could you please explain what you mean by the difference?

Thanks for adding 'SessionHex=', but IMHO, it would be more consistent to either always use hex or always use decimal. smile

#21 Re: mORMot 1 » Weak Authentication Failure » 2014-09-09 21:21:53

avista

Revisiting this issue, I noticed that while I need to specify the session_signature as a hexadecimal value in the URL when calling service functions, logging the user out as described in 19.1.2.2. Session handling:

When the Client is about to close (typically in TSQLRestClientURI.Destroy), a GET ModelRoot/auth?UserName=...&Session=... request is sent to the remote server, in order to explicitly close the corresponding session in the server memory (avoiding most re-play attacks).

requires that instead of using 'session_signature=', I need to use 'session=', and the code expects a decimal value:

function TSQLRestServerAuthentication.AuthSessionRelease(
  Ctxt: TSQLRestServerURIContext): boolean;
var aUserName: RawUTF8;
    aSessionID: cardinal;
    i: integer;
begin
  if UrlDecodeNeedParameters(Ctxt.Parameters,'Session') then begin
    // GET ModelRoot/auth?UserName=...&Session=... -> release session
    while Ctxt.Parameters<>nil do begin
      UrlDecodeValue(Ctxt.Parameters,'USERNAME=',aUserName);
--->  UrlDecodeCardinal(Ctxt.Parameters,'SESSION=',aSessionID,@Ctxt.Parameters); <-----------------------------------------------
    end;
    if (fServer.fSessions<>nil) and
       // allow only to delete its own session - ticket [7723fa7ebd]
       (aSessionID=Ctxt.Session) then
      for i := 0 to fServer.fSessions.Count-1 do
        with TAuthSession(fServer.fSessions.List[i]) do
        if (fIDCardinal=aSessionID) and (fUser.LogonName=aUserName) then begin
          fServer.SessionDelete(i,Ctxt);
          Ctxt.Success;
          break;
        end;
    result := true;
  end else
    result := false;
end;

This seems inconsistent to me...and makes it confusing for the developer that's using my API.

Perhaps at the very least, TSQLRestServerAuthentication.AuthSessionRelease() could be made virtual so I could override its functionality?

Thanks

#22 mORMot 1 » Weak Authentication Failure » 2014-07-14 04:43:21

avista
Replies: 5

Using the Project14ServerHttpWeak sample, I'm unable to get weak authentication working.

http://localhost:888/root/auth?UserName=Admin

Returns:

{
    "result": "386291780+89fe797742fea15af86f0b9c260629ecd11e7ffddb2c500cd667cfea4dcd7128",
    "logonname": "Admin"
}

Subsequent calls after authentication using:

http://localhost:888/root/calculator.add?n1=5&n2=5&session_signature=386291780

or

http://localhost:888/root/calculator.add?n1=5&n2=5&session_signature=386291780+89fe797742fea15af86f0b9c260629ecd11e7ffddb2c500cd667cfea4dcd7128

or

http://localhost:888/root/calculator.add?n1=5&n2=5&session_signature=89fe797742fea15af86f0b9c260629ecd11e7ffddb2c500cd667cfea4dcd7128


All fail with:

{
    "ErrorCode": 403,
    "ErrorText": "Forbidden"
}

What am I doing wrong here?

Thanks

#23 mORMot 1 » How do I safely manage TSQLAuthGroup records at runtime » 2014-07-13 04:06:32

avista
Replies: 1

I'm using Interface Based Services in sicPerThread mode.

When my TSQLRestServerFullMemory service starts I want to be able to add additional TSQLAuthGroup records and/or modify the access rights.  I also want to dynamically add/update/delete entries in this table at runtime.

I've overridden TSQLRestServerAuthenticationNone to support custom TSQLAuthUser creation via the GetUser() method, which works fine for external database user management.  However, I want to use the existing TSQLAuthGroup functionality in mORMot.

My question is what is the best way to manage the AuthGroups table?  I tried overriding the TSQLAuthGroup.InitializeTable() class method to populate the table at startup, but it doesn't get called because the TSQLAuthGroup and TSQLAuthUser classes are set early during service creation (so I can't create my own entries there).

I assume it's just a simple matter of having a routine that deletes existing records and adds new ones as needed at startup?  Also, when the service is running, I'm assuming that any calls to update these tables (e.g. periodically calling a method to do this like MyRestServer.UpdateAuthGroups() from an external thread) will be thread-safe.  Or is there something additional I need to do to ensure thread-safety during runtime?

Thanks

#24 Re: mORMot 1 » User authentication proposal » 2014-07-12 21:36:31

avista

Thanks, I found a discussion about this in section '5.4.1'

#25 Re: mORMot 1 » User authentication proposal » 2014-07-12 19:34:02

avista

I'm confused by this statement:

Result.GroupRights := TSQLAuthGroup(1);

After examining the code, I can see it being used the same way here:

TSQLAuthGroup.InitializeTable(Server: TSQLRestServer;
  const FieldName: RawUTF8);
var G: TSQLAuthGroup;
    A: TSQLAccessRights;
    U: TSQLAuthUser;
    AuthUserIndex, AuthGroupIndex: integer;
    AdminID, SupervisorID, UserID: PtrInt;
begin
[...]

   A := FULL_ACCESS_RIGHTS;
   G.Ident := 'Admin';
   G.SQLAccessRights := A;
   G.SessionTimeout := 10;
   AdminID := Server.Add(G,true); <--------------

[...]

  U.GroupRights := TSQLAuthGroup(AdminID); <--------------

Since 'AdminID' is an integer, and U.GroupRights is a class, how does this work?  Is there somewhere in the documentation where this behavior is described?  I could understand if U.GroupRights was an integer...

Thanks

#26 Re: mORMot 1 » AV in Interface Based Services » 2014-07-10 15:59:02

avista

Why on earth should you provide such incorrect input?

LOL!

Well, since this will be a public facing API for developers, I can't be sure what kind of nonsense will be passed as parameters. wink

Thanks for fixing it!

#27 Re: mORMot 1 » AV in Interface Based Services » 2014-07-10 12:52:57

avista

Yes, I'm using the latest code from the repository.

I'm also using Delphi XE 2 Update 4 Hotfix 1 on Windows 7 6.1 (Build 7601: Service Pack 1)

However, my test case had an additional method, which I didn't show (like in the first case).  Without this method, it doesn't occur, but with this added method, it does:

type
  TMyAttribute = class(TCustomAttribute); <----------------

  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']

    [TMyAttribute] <----------------
    function Add(n1,n2: integer): integer;

    function GetCustomer(CustomerId: Integer; out CustomerData: TCustomerData): Boolean;   <++++++++++++++
  end;

  [...]

// register our ICalculator service on the server side
aServer.ServiceRegister(TServiceCalculator,[TypeInfo(ICalculator)],sicShared);  <----------------

The error occurs here:

procedure TInterfaceFactory.AddMethodsFromTypeInfo(aInterface: PTypeInfo);
[...]

  for i := fMethodsCount to fMethodsCount+n-1 do begin
    // retrieve method name, and add to the methods list (with hashing)
    SetString(aURI,PAnsiChar(@PS^[1]),ord(PS^[0]));
    with PServiceMethod(fMethod.AddUniqueName(aURI,
      '%s.%s method: duplicated name',[fInterfaceTypeInfo^.Name,aURI]))^ do begin
      ExecutionMethodIndex := i+RESERVED_VTABLE_SLOTS;
      PS := @PS^[ord(PS^[0])+1];
      Kind := PME^.Kind;
      if PME^.CC<>ccRegister then
        raise EInterfaceFactoryException.CreateFmt(                <-----------------
          '%s.%s method shall use register calling convention',
          [fInterfaceTypeInfo^.Name,URI]);

[...]

And now, the exception message is truncated to only show a few characters (in the URI variable), so it looks like some kind of memory overwrite.

I can definitely reproduce both cases using the latest code.

#28 Re: mORMot 1 » AV in Interface Based Services » 2014-07-10 06:19:20

avista

On another note, decorating an interface method with an attribute causes an exception when registering the service:

type
  TMyAttribute = class(TCustomAttribute); <----------------

  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']

    [TMyAttribute] <----------------
    function Add(n1,n2: integer): integer;
  end;

  [...]

// register our ICalculator service on the server side
aServer.ServiceRegister(TServiceCalculator,[TypeInfo(ICalculator)],sicShared);  <----------------
Exception class EInterfaceFactoryException with message 'ICalculator. method shall use register calling convention'. Process Project14ServerHttp.exe (9916)

I've implemented code that uses attributes to map URI templates to methods, but this error is preventing me from using it...

Thanks

#29 mORMot 1 » AV in Interface Based Services » 2014-07-10 06:09:37

avista
Replies: 5

Using Project14ServerHttp:

type
  TCustomerData = packed record
    Id: Integer;
    AccountNum: RawUTF8;
    Name: RawUTF8;
    Address: RawUTF8;
  end;

  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
    function Add(n1,n2: integer): integer;
    function GetCustomer(CustomerId: Integer; out CustomerData: TCustomerData): Boolean;  <----------------
  end;

  [...]

type
  TServiceCalculator = class(TInterfacedObject, ICalculator)
  public
    function Add(n1,n2: integer): integer;
    function GetCustomer(CustomerId: Integer; out CustomerData: TCustomerData): Boolean; <----------------
  end;

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

function TServiceCalculator.GetCustomer(CustomerId: Integer; out CustomerData: TCustomerData): Boolean;
begin
  Result := True;
end;

Entering a string parameter instead of the expected integer value generates an AV:

http://localhost:888/root/Calculator.GetCustomer?CustomerId=John%20Doe

{
"ErrorCode":500,
"ErrorText":"Exception EAccessViolation: Access violation at address 004088A8 in module 'Project14ServerHttp.exe'. Read of address 00000004"
}

The error occurs here:

function TServiceMethod.InternalExecute(Instances: array of pointer;
  Par: PUTF8Char; Res: TTextWriter; out aHead: RawUTF8; out aStatus: cardinal;
  Options: TServiceMethodOptions; ResultAsJSONObject: boolean;
  BackgroundExecutionThread: TSynBackgroundThreadProcedure): boolean;

[...]

  finally // manual release memory for Records[], Objects[] and DynArrays[]
    for i := 0 to ArgsUsedCount[smvvObject]-1 do
      Objects[i].Free;
    for i := 0 to ArgsUsedCount[smvvDynArray]-1 do
      DynArrays[i].Wrapper.Clear;
    if Records<>nil then begin
      i := 0;
      for a := 0 to high(Args) do
        with Args[a] do
        case ValueType of
        smvRecord: begin
          RecordClear(pointer(Records[i])^,TypeInfo);  <----------------
          inc(i);
        end;
        {$ifndef NOVARIANTS}
        smvVariant: begin
          VarClear(PVariant(pointer(Records[i]))^); // fast
          inc(i);
        end;
        {$endif}
        end;
    end;
  end;

#30 Re: mORMot 1 » MVC URI routing » 2014-07-08 04:19:01

avista

When a service class instance is created in sicPerThread mode, is it safe to cache the context for subsequent use?

 aServer.ServiceRegister(TMyServiceApi, [TypeInfo(IMyServiceApi)], sicPerThread);

...

constructor TMyServiceApi.Create;
begin
  inherited;
  fContext := ServiceContext; <-----------------
end;

procedure TMyServiceApi.GetCustomer(out aCustomer: TCustomer);
var
  Param1: RawUTF8;
begin
  Param1 := fContext.Input['P1']; <--------------
  ...
end;

Or should the ServiceContext threadvar always be referenced directly when used?

Thanks

#31 Re: mORMot 1 » AV in SynCommons Exception Code » 2014-06-25 15:50:53

avista

Thanks for clearing that up, it is a big relief.

Everything is already clearly stated in the documentation, I guess.

Perhaps you didn't mean it this way, but that statement suggests to me that if I had only RTFM, it would have been obvious what the problem was.

I think for most developers, encountering an AV isn't something that inspires them to say to themselves "Gee, I just encountered an AV.  Perhaps this is supposed to happen and maybe there's an option to turn it off in the documentation." wink

The process goes more like this:

- "Uh oh, I encountered an AV!  Obviously it must be something I did wrong!"
- Find the code where the AV is occurring and try to understand what it's doing.
- See that the bug is occurring in the framework your using, but still think it's your fault.
- Spend a bunch of time debugging the problem trying to find the bug.

So in this case, I think it's reasonable to assume that scouring the documentation for an AV is not something one would be expected to do. smile

Might I respectfully suggest that since it's possible for that code to create unexpected AVs, that the default be set to 

TSynLog.Family.StackTraceUse := stOnlyAPI;

One of my colleagues had this to say:

We can try that, but it concerns me that there is ever an A/V.  For me it erodes my confidence in the stability of the framework.

I'm sure you can see how this option sounds experimental, and code that is expected to "sometimes cause AVs" doesn't sound particularly stable.

I chose this framework after having invested a lot of time reading the forums and the documentation.  I also sincerely appreciate your responsiveness and the help you've provided to date.  The fact that it has so many unit tests also added confidence to my decision.  However, convincing others on my team that this was the route to go after this issue became more difficult.

#32 Re: mORMot 1 » AV in SynCommons Exception Code » 2014-06-24 23:17:25

avista

To confirm, I'm not talking about the standard exception that's raised, I'm talking about the AV that happens after it. 

This happens in one developer's IDE, but not in mine (with the same OS version, Delphi version, project options, etc.).  It makes testing impossible, because the AV keeps happening repeatedly until the application is terminated.

#33 mORMot 1 » AV in SynCommons Exception Code » 2014-06-24 21:58:25

avista
Replies: 5

We are having a strange problem when raising an exception in an Interface Based Method call. 

Unfortunately, we have not been able to reproduce this in a sample application.  The error occurs consistently when the code is called from the IDE and we are also using the latest mORMot build. 

When the service method is called, a standard exception is generated:

function TServiceApi.AccountLookup(const Account: string; out aAccountData: TAccountData): Boolean;
begin
   raise Exception.Create(‘Test Exception’);
end;

Which causes the following AV in SynCommons.pas:

http://www.tiikoni.com/tis/view/?id=10fa80a

and the corresponding stack trace:

http://www.tiikoni.com/tis/view/?id=04ce3be

Notes:

  • TAccountData is a packed record with simple types

  • It only happens when the app is run inside the IDE

  • We are using Delphi XE2 Update 4 Hotfix 1

  • We've run FastMM4 in full debug mode with memory overwrite checking, and then with interface checking and it hasn't reported any problems

We suspect it’s an edge case that the SynCommons.LogExcept() routine isn’t handling or is due to some memory corruption with record based parameters, as we’ve eliminated calls to our custom code, but of course we can't prove this.

At this point, we’re at the end of our rope and can’t figure out what the problem is, so we need some guidance. 

Do you have any ideas about why this may be occurring or how to find the problem?  We could provide TeamViewer access to the machine if necessary.

Thanks in advance.

#34 Re: mORMot 1 » Memory Leak in Interface Based Service Declaration » 2014-06-22 21:15:18

avista

Thanks, we will change the code to avoid this.

#35 Re: mORMot 1 » MVC URI routing » 2014-06-22 20:47:29

avista

Further to the 'convention over configuration' discussion, the method parameters could be used to determine if a URI segment is a variable or not:

GET 'customers/{CustomerId}/reports/orders/{OrderNumber}/details'

function Get_CustomerId_Reports_Orders_OrderNumber_Details(CustomerID: integer; OrderNumber: RawUTF8): TServiceCustomAnswer;

Example: 'customers/1234/reports/orders/5678/details'

So the'_' denotes a '/', and if the text between the segments matches a parameter as declared in the method, it would get parsed out.

Having said this, I think there is some argument to be made for using attributes, because they decouple the method/parameter name(s) from the URL used to call it.  That could be useful to prevent changes to the method from causing unexpected URI routing errors, and provides a lot of flexibility to present the URI to the consumer in any way they expect, without tying it explicitly to the implementation method name or parameters.

[WebGet('customers/{aCustomerId}/reports/orders/{aOrderNumber}/details?Filter={aDetailFilter}')]

function GetCustomerOrderDetails(aCustomerId: integer; aOrderNumber, aDetailFilter: RawUTF8): TServiceCustomAnswer;

As discussed previously, having access to the Context (if present as a parameter) would cover any case.  Also, if a '?*' was at the end, the system would not expect the options to be passed in a method parameter:

[WebGet('customers/{aCustomerId}/reports/orders/{aOrderNumber}/details?*')]

function GetCustomerOrderDetails(Ctxt: TSQLRestServerURIContext; aCustomerId: integer; aOrderNumber: RawUTF8): TServiceCustomAnswer;

That seems to cover all the bases, but I'm still interested to know more about how the MVC pattern that was proposed would work.

Thoughts? Comments?

#36 Re: mORMot 1 » Memory Leak in Interface Based Service Declaration » 2014-06-22 20:17:15

avista

Glad my example helped. smile

I've encountered another case, where the memory manager reports a leak.

If you reference a threadvar in the code, before raising an exception, a leak occurs:

threadvar            <---------------------------------
  aString: string;   <---------------------------------

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

function TServiceCalculator.GetTestRec(Id: integer; out aRec: TTestRec): Boolean;
begin
  aRec.Value1 := 1;
  aRec.Value2 := 2;
  aRec.Value3 := 'test';
  aString := 'test'; <---------------------------------
  raise Exception.Create('Error Message');
  Result := True;
end;

It's an unusual case, but we encountered it because one of our threads did something similar.

#37 Re: mORMot 1 » Automatic JSON serialization of record via Enhanced RTTI » 2014-06-21 20:29:54

avista

Thanks! smile

#38 mORMot 1 » Memory Leak in Interface Based Service Declaration » 2014-06-21 20:24:56

avista
Replies: 4

I suspect this is related to the new automatic RTTI initialization of records for serialization.

Using the 'Project14ServerHttp' demo, the following declaration in the interface will cause a memory leak:

/// some common definitions shared by both client and server side 
unit Project14Interface;

interface

type
  TTestRec = packed record
    Value1: Integer;
    Value2: Integer;
  end;

  ICalculator = interface(IInvokable)
    ['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
    function Add(n1,n2: integer): integer;
    function GetTestRec(Id: integer; out aRec: TTestRec): Boolean; <-----------------------
  end;

const
  ROOT_NAME = 'root';
  PORT_NAME = '888';
  APPLICATION_NAME = 'RestService';

implementation

end.
/// this server will use TSQLRestServerFullMemory over HTTP
program Project14ServerHttp;

{$APPTYPE CONSOLE}

uses
  FastMM4,
  SysUtils,
  Classes,
  SynCommons,
  mORMot,
  mORMotHttpServer,
  Project14Interface;

type
  TServiceCalculator = class(TInterfacedObjectWithCustomCreate, ICalculator)
  public
    function Add(n1,n2: integer): integer;
    function GetTestRec(Id: integer; out aRec: TTestRec): Boolean;
  end;

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

function TServiceCalculator.GetTestRec(Id: integer; out aRec: TTestRec): Boolean;
begin
  aRec.Value1 := 1;
  aRec.Value2 := 2;
  Result := True;
end;

[...]
begin
  ReportMemoryLeaksOnShutdown := True; <-----------------------
  [...]
end.

You just need to run it, and then press the Enter key.

#39 Re: mORMot 1 » Automatic JSON serialization of record via Enhanced RTTI » 2014-06-20 19:19:04

avista

I've added support to the code for enabling serialization options for records (e.g.,  soReadIgnoreUnknownFields, soWriteHumanReadable).

  TJSONCustomParserFromRTTI = class(TJSONCustomParserAbstract)
  protected
    fRecordTypeInfo: pointer;
    function AddItemFromRTTI(const PropertyName: RawUTF8;
      Info: pointer; ItemSize: integer): TJSONCustomParserRTTI;
    {$ifdef ISDELPHI2010}
    procedure FromEnhancedRTTI(Props: TJSONCustomParserRTTI; Info: pointer);
    {$endif}
  public
    /// initialize the instance
    // - you should NOT use this constructor directly, but let e.g.
    // TJSONCustomParsers.TryToGetFromRTTI() create it for you
    constructor Create(aRecordTypeInfo: pointer; aRoot: TJSONCustomParserRTTI); reintroduce;
    /// set custom serialization options for records
    class procedure SetRecordSerializationOptions(aRecordTypeInfo: pointer; aOptions: TJSONCustomParserSerializationOptions); // <--------------
    /// the low-level address of the enhanced RTTI
    property RecordTypeInfo: pointer read fRecordTypeInfo;
  end;

[...]

class procedure TJSONCustomParserFromRTTI.SetRecordSerializationOptions(
  aRecordTypeInfo: pointer; aOptions: TJSONCustomParserSerializationOptions);
var
  ndx: Integer;
begin
  if (aRecordTypeInfo=nil) or (PFieldTable(aRecordTypeInfo)^.kind<>tkRecord) then
    raise ESynException.Create('Invalid record type in TJSONCustomParserFromRTTI.SetRecordSerializationOptions');
  ndx := GlobalJSONCustomParsers.RecordSearch(aRecordTypeInfo);
  if (ndx>=0) then
    GlobalJSONCustomParsers.fParser[ndx].RecordCustomParser.Options := aOptions;
end;

Example:

procedure SetMyRecordSerializationOptions;
var
  Options: TJSONCustomParserSerializationOptions;
begin
  Options := [soReadIgnoreUnknownFields,soWriteHumanReadable];
  TJSONCustomParserFromRTTI.SetRecordSerializationOptions(TypeInfo(TCustomerRecord), Options);
end;

I've created a corresponding ticket for this here:

http://synopse.info/fossil/info/da22968223

#40 Re: mORMot 1 » Custom HTTP Status Code in Interface Based Services » 2014-06-20 16:20:41

avista

Thanks, it is very much appreciated!

#41 mORMot 1 » Custom HTTP Status Code in Interface Based Services » 2014-06-19 23:46:12

avista
Replies: 3

As stated here, it seems impossible:

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

I've been working on a web service API for consumption by others via JavaScript, etc. using Interface Based Services, but without support for custom status codes, the project cannot move forward.

Is there any way at all to return a custom HTTP Status code for Interface Based Services?

In the above post, you said:

By now, it expects HTML_SUCCESS (200) on the client side for any success full process.
See e.g. TServiceFactoryClient.InternalInvoke().

So allowing any custom code may be very difficult, and break the default expected behavior of the JSON-RPC protocol.

Note that if you raise an exception, it will return an error 500 to the client.

I'm wondering how this would break existing code.  Why would it be a problem for the client to continue to require HTML_SUCCESS (200), but fail on a non-200 status code?

I changed the following code in mORMot.pas to enable returning a status code in TServiceCustomAnswer, which seems to work.

Note that if the Status is 0, it will default to HTML_SUCCESS (200).

  TServiceCustomAnswer = record
    Status: Cardinal; // <-----------------
    Header: RawUTF8;
    Content: RawByteString;
  end;
function TServiceMethod.InternalExecute(Instances: array of pointer;
  Par: PUTF8Char; Res: TTextWriter; var aHead: RawUTF8; var aStatus: Cardinal; // <-----------------
  Options: TServiceMethodOptions; ResultAsJSONObject: boolean;
  BackgroundExecutionThread: TSynBackgroundThreadProcedure): boolean;
procedure TServiceFactoryServer.ExecuteMethod(Ctxt: TSQLRestServerURIContext);
[…]
      Ctxt.ServiceResultStart(WR);
      try
        if optExecLockedPerInterface in fExecution[Ctxt.ServiceMethodIndex].Options then
          EnterCriticalSection(fInstanceLock);
        if not fInterface.fMethods[Ctxt.ServiceMethodIndex].InternalExecute(
            [PAnsiChar(Inst.Instance)+entry^.IOffset],Ctxt.ServiceParameters,WR,
             Ctxt.Call.OutHead,Ctxt.Call.OutStatus, // <-----------------
             fExecution[Ctxt.ServiceMethodIndex].Options,
             Ctxt.ForceServiceResultAsJSONObject,
             {$ifdef LVCL}nil{$else}fBackgroundThread{$endif}) then
          exit; // wrong request
      finally
        if optExecLockedPerInterface in fExecution[Ctxt.ServiceMethodIndex].Options then
          LeaveCriticalSection(fInstanceLock);
      end;
      if Ctxt.Call.OutHead='' then begin // <>'' for TServiceCustomAnswer
        Ctxt.ServiceResultEnd(WR,Inst.InstanceID);
        Ctxt.Call.OutHead := JSON_CONTENT_TYPE_HEADER;
        Ctxt.Call.OutStatus := HTML_SUCCESS;  // <-----------------
      end
      else if (Ctxt.Call.OutStatus = 0) then // <-----------------
        Ctxt.Call.OutStatus := HTML_SUCCESS; // <-----------------
      WR.SetText(Ctxt.Call.OutBody);
      // Ctxt.Call.OutStatus := HTML_SUCCESS; // <----------------- commented out
[…]
end;

Does this seem like a viable solution?

#42 Re: mORMot 1 » MVC URI routing » 2014-06-11 02:39:51

avista

I still prefer the automated approach, as this is for developer consumption anyway.

I also think use of regular expressions is overkill and slow.  I initially tried that approach, but it's actually far more complicated than at first it seems.  URI templates are really not that complicated, as they essentially identify which URI path segments contain variables.  The parser I wrote handles all of these cases and is very fast.

Regarding Arnaud's proposal, to avoid the ambiguity with the following case:

GET 'customers/{CustomerId}/reports/orders/{OrderNumber}/details'

function get_reports_orders_details(CustomerID: integer; OrderNumber: RawUTF8): TServiceCustomAnswer;

Camel-case could be required to delineate segments that do not contain parameters:

GET 'customers/{CustomerId}/reports/orders/{OrderNumber}/details'

function get_reportsOrders_details(CustomerID: integer; OrderNumber: RawUTF8): TServiceCustomAnswer;

Another approach could be to use a predetermined numeric value (e.g., '0' - zero) to denote the parameters:

GET 'customers/{CustomerId}/reports/orders/{OrderNumber}/details'

function Get_0_Reports_Orders_0_Details(CustomerID: integer; OrderNumber: RawUTF8): TServiceCustomAnswer;

Which is IMHO *much* more readable.

Quite frankly, I want to spend as little time with configuration as possible, because I have too much work to do already.

So an implementation that just works 'automagically' as Arnaud says is a huge plus for me. smile

#43 Re: mORMot 1 » MVC URI routing » 2014-06-10 17:05:10

avista

Nice!  I like the "convention over configuration" idea.

Just so I understand, the following examples would work?

// for GET 'customers/{CustomerId}/invoices/{InvoiceNumber}/orders/{OrderNumber}'
function get_invoices_orders(CustomerID: integer; const InvoiceNumber, OrderNumber: RawUTF8): TServiceCustomAnswer;

// for GET 'customers/{CustomerId}/reports/orders/active'
function get_reports_orders_active(CustomerID: integer): TServiceCustomAnswer;

But this seems problematic:

// for GET 'customers/{CustomerId}/reports/orders/{OrderNumber}/details'
function get_reports_orders_details(CustomerID: integer; OrderNumber: RawUTF8): TServiceCustomAnswer;

Because the convention would expect:

'customers/{CustomerId}/reports/{OrderNumber}/orders/details'

instead of:

'customers/{CustomerId}/reports/orders/{OrderNumber}/details'

Which is what method attributes could solve.

And what about '?' parameters, as they will be necessary from some operations?

// for GET 'customers/{CustomerId}/reports/orders?$Filter=Price.gt.100&$OrderBy=OrderDate'
function get_reports_orders(CustomerID: integer; Filter, OrderBy: RawUTF8): TServiceCustomAnswer;

Of course, this would run into the same problems with the 'Filter' expected after the 'reports/'.

In any case, I think it would be important to have the method signature parameters after the '?' optional (if they aren't present in the method signature), because they are typically dynamic:

// for GET 'customers/{CustomerId}/reports/orders?$Filter=Price.gt.100&$OrderBy=OrderDate'
function get_reports_orders(CustomerID: integer): TServiceCustomAnswer;
var
  Filter, OrderBy: RawUTF8;
begin
  Filter := Ctxt.Input['Filter'];
  OrderBy := Ctx.Input['OrderBy'];
end;

So if the parameters after the '?' are present in the method signature, then they are passed as arguments, otherwise they can be accessed via the Ctxt object (notwithstanding the problems mentioned above).

We may allow to define a Ctxt: TSQLRestServerURIContext input parameter to let the method directly access all input content, in addition to Body: RawByteString.

Having the option to specify a Ctxt parameter is a great idea, as above to be used for '?' parameters.  I assume this would be an optional parameter?

With:

function get_reports_orders(Ctxt: TSQLRestServerURIContext; CustomerID: integer): TServiceCustomAnswer;

Without:

function get_reports_orders(CustomerID: integer): TServiceCustomAnswer;

Additional thoughts?

#44 mORMot 1 » Automatic JSON serialization of record via Enhanced RTTI » 2014-06-05 04:47:15

avista
Replies: 11

Arnaud,

Thanks for implementing this feature!

It's ironic, because I spent quite a bit of time implementing this feature in SynCommons.pas, and was about to send my changes to you when you blogged about it. smile

In any case, there are a few scenarios my code supports that the new built-in serialization does not:

1. Static Arrays of both simple and record types (serialization will fail with any of the declarations below with an exception)

  TMyRecord = packed record
    Name: string;
    Age: Integer;
  end;

  TIntArray = array[1..5] of Integer;

  TRecArray = array[1..5] of TMyRecord;

  TTestRec = record
    IntArrayInline: array[1..5] of Integer;
    IntArrayNamed: TIntArray;
    RecArrayInline: array[1..5] of TMyRecord;
    RecArrayNamed: TRecArray;
  end;

You may ask why not just use dynamic arrays?  Because sometimes it's cleaner to use a static array (especially if a fixed number of items are assumed in the code) and I have existing records with static arrays that must be serialized. wink

2.  Serialization Options

  TJSONCustomParserSerializationOption = (
    soReadIgnoreUnknownFields, soWriteHumanReadable,
    soCustomVariantCopiedByReference);

Specifically soReadIgnoreUnknownFields and soWriteHumanReadable, which are important for my application.

I had also added another option to trim the prefixes from enumerated types both when writing and reading them:

  TJSONRecordParserOption = (poTrimLeftLowerCaseEnums);

Would it be possible to implement support for static arrays and the serialization options in the new RTTI record serialization code?

On another note, I'd like to send you the modified code with a small sample application for testing, so you can see how I implemented it (maybe it could be useful, but I expect that your implementation is much better).  I tried following the existing code conventions as much as possible.

Where can I post/email my modified SynCommons.pas file so you can get it?

#45 mORMot 1 » Bug In Record De-Serialization of Currency Type » 2014-05-13 02:03:07

avista
Replies: 1

In the code below:

Rec.Curr is set to 100 and is serialized correctly:

Json1 =  '{"Id":55,"Name":"This is the name.","Curr":100}'

However, it is de-serialized incorrectly in the call to

    RecordLoadJSON(Rec, @Json1Copy[1], TypeInfo(TTestRec));

Rec.Curr =  1000000

Json2 = '{"Id":55,"Name":"This is the name.","Curr":1000000}'

program JsonBug;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  SynCommons;

type
  TTestRec = packed record
    Id: Integer;
    Name: string;
    Curr: Currency;
  end;

const
  __TTestRec = 'Id: Integer; Name: string; Curr: Currency;';

var
  Rec: TTestRec;
  Json1, Json1Copy, Json2: RawUTF8;
begin
  try
    Rec.Id := 55;
    Rec.Name := 'This is the name.';
    Rec.Curr := 100;

    TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TTestRec), __TTestRec);
    Json1 := RecordSaveJSON(Rec, TypeInfo(TTestRec));
    Json1Copy := Json1;
    Rec := Default(TTestRec);

    RecordLoadJSON(Rec, @Json1Copy[1], TypeInfo(TTestRec));
    Json2 := RecordSaveJSON(Rec, TypeInfo(TTestRec));

    Assert(SameTextU(Json1, Json2));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Sorry for the recent bug reports. sad

#46 Re: mORMot 1 » BREAKING CHANGE: TSQLRestServerStatic* renamed as TSQLRestStorage* » 2014-05-12 23:24:25

avista

I noticed everything seemed to work fine, but wasn't sure.  Thanks for fixing it anyway! smile

#47 Re: mORMot 1 » BREAKING CHANGE: TSQLRestServerStatic* renamed as TSQLRestStorage* » 2014-05-12 03:30:05

avista

Thanks for the update.

Unfortunately, it looks like the Project14ServerHttp.dpr sample now builds with the following warnings:

[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineAdd'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineRetrieve'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineList'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineUpdate'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineDelete'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineDeleteWhere'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineRetrieveBlob'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineUpdateBlob'
[DCC Warning] Project14ServerHttp.dpr(40): W1020 Constructing instance of 'TSQLRestServerFullMemory' containing abstract method 'TSQLRestServer.MainEngineUpdateField'

Assuming I have the correct build wink:

mORMot_and_Open_Source_friends_2014-05-10_181139_0c5bad111b

#48 Re: mORMot 1 » Bug in StrCommons.StrInt64() function for minimum Int64 value » 2014-05-08 17:15:44

avista

Thanks, I've confirmed that this fixes the problem. smile

#49 Re: mORMot 1 » Bug in StrCommons.StrInt64() function for minimum Int64 value » 2014-05-07 15:24:04

avista

Int64ToUtf8(-9223372036854775808) works under XE2, however I'm using this conversion with text based record serialization, which fails and returns garbage:

procedure DoTestRec;
type
  TTestRec = packed record
    aInt64: Int64;
  end;
const
  __TestRec = 'aInt64 Int64';
var
  Rec: TTestRec;
  Json: RawUTF8;
begin
  TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TTestRec), __TestRec);
  Rec.aInt64 := -9223372036854775808;
  Json := RecordSaveJSON(Rec, TypeInfo(TTestRec));
  Writeln(Json);
end;

{"aInt64":-E'#0'Ü›F'#0'D›E'#0'T˜'#0#0'F'#0'h›ü'#$1A'}

1 more than the minimum value returns the correct JSON:

{"aInt64":-9223372036854775807}

I traced the call to the following routine, which is why I created the small test application in my previous email:

procedure TTextWriter.Add(Value: Int64);
var tmp: array[0..23] of AnsiChar;
    P: PAnsiChar;
    Len: integer;
begin
  if B+24>=BEnd then
    Flush;
{$ifdef CPU64}
  P := StrInt32(@tmp[23],Value); // StrInt32 use PtrInt, i.e. Int64
{$else}
  P := StrInt64(@tmp[23],Value);
{$endif}
  Len := @tmp[23]-P;
  move(P[0],B[1],Len);
  inc(B,Len);
end;

Thanks

#50 mORMot 1 » Bug in StrCommons.StrInt64() function for minimum Int64 value » 2014-05-07 05:18:38

avista
Replies: 4

Using Delphi XE2, 32-bit target:

For the minimum Int64 value of -9223372036854775808, StrInt64() returns an invalid result (however StrInt32 works fine for the minimum 32 bit value):

program StrToInt64Bug;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SynCommons,
  System.SysUtils;

procedure DoInt32ToStr(Value: Integer);
var
  tmp: array[0..23] of AnsiChar;
  output: array[0..23] of AnsiChar;
  P: PAnsiChar;
  T: PAnsiChar;
  Len: Integer;
begin
  FillChar(tmp, SizeOf(tmp), 0);
  T := @tmp[23];
  P := StrInt32(T, Value);
  Len := T-P;
  FillChar(output, SizeOf(output), 0);
  move(P[0],output[0],Len);
  Writeln;
  Writeln('SynCommons.StrInt32(', Value, ') = ', output);
end;

procedure DoInt64ToStr(Value: Int64);
var
  tmp: array[0..23] of AnsiChar;
  output: array[0..23] of AnsiChar;
  P: PAnsiChar;
  T: PAnsiChar;
  Len: Integer;
begin
  FillChar(tmp, SizeOf(tmp), 0);
  T := @tmp[23];
  P := StrInt64(T, Value);
  Len := T-P;
  FillChar(output, SizeOf(output), 0);
  move(P[0],output[0],Len);
  Writeln;
  Writeln('SynCommons.StrInt64(', Value, ') = ', output);
end;

var
  Value32: Integer;
  Value64: Int64;
begin
  try
    // 32 bit
    Value32 := Low(Integer);
    Writeln('Low(Integer) = ', Value32);
    DoInt32ToStr(Value32);
    Writeln;

    Value32 := Low(Int32)+1;
    Writeln('Low(Int32)+1 = ', Value32);
    DoInt32ToStr(Value32);
    Writeln;

    // 64 bit
    Value64 := Low(Int64);
    Writeln('Low(Int64) = ', Value64);
    DoInt64ToStr(Value64);
    Writeln;

    Value64 := Low(Int64)+1;
    Writeln('Low(Int64)+1 = ', Value64);
    DoInt64ToStr(Value64);
    Writeln;

    Writeln;
    Writeln('Press ENTER to continue...');
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Pages: 1 2

Board footer

Powered by FluxBB