properties of records: so our code is disabled (see PUBLISHRECORD
      conditional) :( - but you can use dynamic arrays of records
    - TPersistent can be now be specified for TSQLRecord published properties:
      a new sftObject field kind has been added - will be stored as TEXT in the
      database (following the ObjectToJSON serialization format) - TStrings or
      TRawUTF8List will be stored as a JSON array of string, and TCollection
      as a JSON array of objects, other TPersistent classes will have their
      published properties serialized as a JSON object  
    - introducing direct content filtering and validation using
      TSynFilterOrValidate dedicated classes
    - filtering is handled directly in the new TSQLRecord.Filter virtual method,
      or via some TSynFilter classes - TSynFilterUpperCase, TSynFilterUpperCaseU,
      TSynFilterLowerCase, TSynFilterLowerCaseU and TSynFilterTrim e.g.
    - validation is handled in the new TSQLRecord.Validate virtual method,
      or via some TSynValidate classes - TSynValidateRest, TSynValidateIPAddress,
................................................................................
    - huge code refactoring of the ORM model implementation: a new dedicated
      TSQLModelRecordProperties will contain per-TSQLModel parameters, whereas
      shared information retrieved by RTTI remain in TSQLRecordProperties - this
      will allow use of the same TSQLRecord in several TSQLModel at once, with
      dedicated SQL auto-generation and external DB settings
    - added aExternalTableName/Database optional parameters to method
      TSQLModel.VirtualTableRegister()


    - TSQLAuthUser and TSQLAuthGroup have now "index ..." attributes to their
      RawUTF8 properties, to allow direct handling in external databases
    - new protected TSQLRestServer.InternalAdaptSQL method, extracted from URI()
      process to also be called by TSQLRestServer.InternalListJSON() for proper
      TSQLRestServerStatic.AdaptSQLForEngineList(SQL) call
    - changed TSQLAccessRights and TSQLAuthGroup.SQLAccessRights CSV format
      to use 'first-last,' pattern to regroup set bits (reduce storage size)
................................................................................
  // tables may not exist in the main SQLite3 database, but in-memory or external
  // - don't modify the order of Tables inside this Model, if you publish
  // some TRecordReference property in any of your tables
  TSQLModel = class(TObject)
  private
    fTables: TSQLRecords;
    fRoot: RawUTF8;

    fTablesMax: integer;
    fActions: PEnumType;
    fEvents: PEnumType;
    fTableProps: TSQLModelRecordPropertiesDynArray;
    /// contains the caller of CreateOwnedStream()
    fOwner: TSQLRest;
    /// for every table, contains a locked record list
................................................................................
    // - reflects the internal private fIsUnique propery
    function GetIsUnique(aTable: TSQLRecordClass; aFieldIndex: integer): boolean;
    /// try to retrieve a table index from a SQL statement
    // - naive search of '... FROM TableName' pattern in the supplied SQL
    // - if EnsureUniqueTableInFrom is TRUE, it will check that only one Table
    // is in the FROM clause, otherwise it will return the first Table specified
    function GetTableIndexFromSQLSelect(const SQL: RawUTF8; EnsureUniqueTableInFrom: boolean): integer;





    /// assign an enumeration type to the possible actions to be performed
    // with this model
    // - call with the TypeInfo() pointer result of an enumeration type
    // - actions are handled by TSQLRecordForList in the SQLite3ToolBar unit
    procedure SetActions(aActions: PTypeInfo);
    /// assign an enumeration type to the possible events to be triggered
................................................................................
  SetLength(fTablesName,N);
  SetLength(fTablesNameIndex,N);
  SetLength(fTableProps,N);
  // initialize internal properties
  for i := 0 to fTablesMax do
    SetTableProps(Tables[i],i,(i=fTablesMax));
  // set the optional Root URI path of this Model



  fRoot := aRoot;
end;

function TSQLModel.GetMainFieldName(Table: TSQLRecordClass;
  ReturnFirstIfNoUnique: boolean=false): RawUTF8;
begin
  if Table<>nil then
    with Table.RecordProps do
................................................................................

function TSQLModel.getURI(aTable: TSQLRecordClass): RawUTF8;
begin
  if (self<>nil) and (Root<>'') then
    result := Root+'/'+aTable.RecordProps.SQLTableName else
    result := aTable.RecordProps.SQLTableName;
end;













function TSQLModel.NewRecord(const SQLTableName: RawUTF8): TSQLRecord;
var aClass: TSQLRecordClass;
begin
  aClass := Table[SQLTableName];
  if aClass=nil then
    result := nil else

      properties of records: so our code is disabled (see PUBLISHRECORD
      conditional) :( - but you can use dynamic arrays of records
    - TPersistent can be now be specified for TSQLRecord published properties:
      a new sftObject field kind has been added - will be stored as TEXT in the
      database (following the ObjectToJSON serialization format) - TStrings or
      TRawUTF8List will be stored as a JSON array of string, and TCollection
      as a JSON array of objects, other TPersistent classes will have their
      published properties serialized as a JSON object
    - introducing direct content filtering and validation using
      TSynFilterOrValidate dedicated classes
    - filtering is handled directly in the new TSQLRecord.Filter virtual method,
      or via some TSynFilter classes - TSynFilterUpperCase, TSynFilterUpperCaseU,
      TSynFilterLowerCase, TSynFilterLowerCaseU and TSynFilterTrim e.g.
    - validation is handled in the new TSQLRecord.Validate virtual method,
      or via some TSynValidate classes - TSynValidateRest, TSynValidateIPAddress,
................................................................................
    - huge code refactoring of the ORM model implementation: a new dedicated
      TSQLModelRecordProperties will contain per-TSQLModel parameters, whereas
      shared information retrieved by RTTI remain in TSQLRecordProperties - this
      will allow use of the same TSQLRecord in several TSQLModel at once, with
      dedicated SQL auto-generation and external DB settings
    - added aExternalTableName/Database optional parameters to method
      TSQLModel.VirtualTableRegister()
    - added TSQLModel.URIMatch() method to allow sub-domains generic matching
      at database model level (so that you can set root='/root/sub1' URIs)
    - TSQLAuthUser and TSQLAuthGroup have now "index ..." attributes to their
      RawUTF8 properties, to allow direct handling in external databases
    - new protected TSQLRestServer.InternalAdaptSQL method, extracted from URI()
      process to also be called by TSQLRestServer.InternalListJSON() for proper
      TSQLRestServerStatic.AdaptSQLForEngineList(SQL) call
    - changed TSQLAccessRights and TSQLAuthGroup.SQLAccessRights CSV format
      to use 'first-last,' pattern to regroup set bits (reduce storage size)
................................................................................
  // tables may not exist in the main SQLite3 database, but in-memory or external
  // - don't modify the order of Tables inside this Model, if you publish
  // some TRecordReference property in any of your tables
  TSQLModel = class(TObject)
  private
    fTables: TSQLRecords;
    fRoot: RawUTF8;
    fRootUpper: RawUTF8;
    fTablesMax: integer;
    fActions: PEnumType;
    fEvents: PEnumType;
    fTableProps: TSQLModelRecordPropertiesDynArray;
    /// contains the caller of CreateOwnedStream()
    fOwner: TSQLRest;
    /// for every table, contains a locked record list
................................................................................
    // - reflects the internal private fIsUnique propery
    function GetIsUnique(aTable: TSQLRecordClass; aFieldIndex: integer): boolean;
    /// try to retrieve a table index from a SQL statement
    // - naive search of '... FROM TableName' pattern in the supplied SQL
    // - if EnsureUniqueTableInFrom is TRUE, it will check that only one Table
    // is in the FROM clause, otherwise it will return the first Table specified
    function GetTableIndexFromSQLSelect(const SQL: RawUTF8; EnsureUniqueTableInFrom: boolean): integer;
    /// returns TRUE if the supplied URI matches the model's Root property
    // - allows sub-domains, e.g. if Root='root/sub1', then '/root/sub1/toto' and
    // '/root/sub1?n=1' will match, whereas '/root/sub1nope/toto' won't 
    function URIMatch(const URI: RawUTF8): boolean;

    /// assign an enumeration type to the possible actions to be performed
    // with this model
    // - call with the TypeInfo() pointer result of an enumeration type
    // - actions are handled by TSQLRecordForList in the SQLite3ToolBar unit
    procedure SetActions(aActions: PTypeInfo);
    /// assign an enumeration type to the possible events to be triggered
................................................................................
  SetLength(fTablesName,N);
  SetLength(fTablesNameIndex,N);
  SetLength(fTableProps,N);
  // initialize internal properties
  for i := 0 to fTablesMax do
    SetTableProps(Tables[i],i,(i=fTablesMax));
  // set the optional Root URI path of this Model
  if aRoot<>'' then
    if aRoot[length(aRoot)]='/' then
      fRoot := copy(aRoot,1,Length(aRoot)-1) else
      fRoot := aRoot;
end;

function TSQLModel.GetMainFieldName(Table: TSQLRecordClass;
  ReturnFirstIfNoUnique: boolean=false): RawUTF8;
begin
  if Table<>nil then
    with Table.RecordProps do
................................................................................

function TSQLModel.getURI(aTable: TSQLRecordClass): RawUTF8;
begin
  if (self<>nil) and (Root<>'') then
    result := Root+'/'+aTable.RecordProps.SQLTableName else
    result := aTable.RecordProps.SQLTableName;
end;

function TSQLModel.URIMatch(const URI: RawUTF8): boolean;
begin
  result := false;
  if (self=nil) or (fRoot='') or (URI='') then
    exit;
  if fRootUpper='' then
    UpperCaseCopy(fRoot,fRootUpper);
  if IdemPChar(pointer(URI),pointer(fRootUpper)) then
    if URI[length(fRootUpper)+1] in [#0,'/','?'] then
      result := true;
end;

function TSQLModel.NewRecord(const SQLTableName: RawUTF8): TSQLRecord;
var aClass: TSQLRecordClass;
begin
  aClass := Table[SQLTableName];
  if aClass=nil then
    result := nil else

      - made URI check case-insensitive (as for official RFC)
      - TSQLite3HttpServer will now call virtual TSQLRestServer.EndCurrentThread
        method in each of its terminating threads, to release any thread-specific
        resources (for instance, external connections in SQlite3DB)

    Version 1.18
      - added TSQLite3HttpServer.RemoveServer() method




}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
................................................................................
  for i := 0 to high(aServers) do
    if (aServers[i]=nil) or (aServers[i].Model=nil) then
      ErrMsg := 'Invalid TSQLRestServer';
  if ErrMsg='' then
    for i := 0 to high(aServers) do
    with aServers[i].Model do
    for j := i+1 to high(aServers) do
      if aServers[j].Model.Root=Root then
        ErrMsg:= 'Duplicated Root URI';
  if ErrMsg<>'' then
     raise EModelException.CreateFmt('%s.Create: %s',[ClassName,ErrMsg]);
  SetLength(fDBServers,length(aServers));
  for i := 0 to high(aServers) do
  with fDBServers[i] do begin
    Server := aServers[i];
    RestAccessRights := HTTP_DEFAULT_ACCESS_RIGHTS;
................................................................................
  if (Self<>nil) and (cardinal(Index)<cardinal(length(fDBServers))) then
    fDBServers[Index].RestAccessRights := Value;
end;

function TSQLite3HttpServer.Request(
  const InURL, InMethod, InHeaders, InContent, InContentType: RawByteString;
    out OutContent, OutContentType, OutCustomHeader: RawByteString): cardinal;
var URL, Root, Head: RawUTF8;
    i,j: integer;
    P: PUTF8Char;
begin
  if (InURL='') or (InMethod='') or
     (OnlyJSONRequests and
      not IdemPChar(pointer(InContentType),'APPLICATION/JSON')) then
    // wrong Input parameters or not JSON request: 400 BAD REQUEST
    result := 400 else begin
    if InURL[1]='/' then  // try any left '/' from URL
      i := 2 else
      i := 1;
    URL := copy(InURL,i,maxInt);
    j := PosEx(RawUTF8('/'),URL,1); // extract Root (root/1234)
    if j=0 then
      j := PosEx(RawUTF8('?'),URL,1); // extract Root (root?session_signature=...)
    if j=0 then
      Root := URL else
      Root := copy(URL,1,j-1);

    result := 404; // page not found by default (in case of wrong URL)
    for i := 0 to high(fDBServers) do
    with fDBServers[i] do
      if IdemPropNameU(Server.Model.Root,Root) then
      with Server.URI(URL,InMethod,InContent,RawUTF8(OutContent),Head,RestAccessRights) do begin
        result := Lo;
        P := pointer(Head);
        if IdemPChar(P,'CONTENT-TYPE: ') then begin
          // change mime type if modified in HTTP header (e.g. GET blob fields)
          OutContentType := GetNextLine(P+14,P);
          Head := P;

      - made URI check case-insensitive (as for official RFC)
      - TSQLite3HttpServer will now call virtual TSQLRestServer.EndCurrentThread
        method in each of its terminating threads, to release any thread-specific
        resources (for instance, external connections in SQlite3DB)

    Version 1.18
      - added TSQLite3HttpServer.RemoveServer() method
      - TSQLite3HttpServer now handles sub-domains generic matching (via
        TSQLModel.URIMatch call) at database model level (e.g. you can set
        root='/root/sub1' URIs)

}

interface

{$define COMPRESSSYNLZ}
{ if defined, will use SynLZ for content compression
................................................................................
  for i := 0 to high(aServers) do
    if (aServers[i]=nil) or (aServers[i].Model=nil) then
      ErrMsg := 'Invalid TSQLRestServer';
  if ErrMsg='' then
    for i := 0 to high(aServers) do
    with aServers[i].Model do
    for j := i+1 to high(aServers) do
      if aServers[j].Model.URIMatch(Root) then
        ErrMsg:= Format('Duplicated Root URI: %s and %s',[Root,aServers[j].Model.Root]);
  if ErrMsg<>'' then
     raise EModelException.CreateFmt('%s.Create: %s',[ClassName,ErrMsg]);
  SetLength(fDBServers,length(aServers));
  for i := 0 to high(aServers) do
  with fDBServers[i] do begin
    Server := aServers[i];
    RestAccessRights := HTTP_DEFAULT_ACCESS_RIGHTS;
................................................................................
  if (Self<>nil) and (cardinal(Index)<cardinal(length(fDBServers))) then
    fDBServers[Index].RestAccessRights := Value;
end;

function TSQLite3HttpServer.Request(
  const InURL, InMethod, InHeaders, InContent, InContentType: RawByteString;
    out OutContent, OutContentType, OutCustomHeader: RawByteString): cardinal;
var URL, Head: RawUTF8;
    i: integer;
    P: PUTF8Char;
begin
  if (InURL='') or (InMethod='') or
     (OnlyJSONRequests and
      not IdemPChar(pointer(InContentType),'APPLICATION/JSON')) then
    // wrong Input parameters or not JSON request: 400 BAD REQUEST
    result := 400 else begin
    if InURL[1]='/' then  // trim any left '/' from URL


      URL := copy(InURL,2,maxInt) else






      URL := InURL;
    result := 404; // page not found by default (in case of wrong URL)
    for i := 0 to high(fDBServers) do
    with fDBServers[i] do
      if Server.Model.URIMatch(URL) then
      with Server.URI(URL,InMethod,InContent,RawUTF8(OutContent),Head,RestAccessRights) do begin
        result := Lo;
        P := pointer(Head);
        if IdemPChar(P,'CONTENT-TYPE: ') then begin
          // change mime type if modified in HTTP header (e.g. GET blob fields)
          OutContentType := GetNextLine(P+14,P);
          Head := P;