Browse Source

* Connection management, start of logging

git-svn-id: trunk@41786 -
michael 6 years ago
parent
commit
78c074bb74

+ 334 - 22
packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -22,7 +22,7 @@ uses
   Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
   Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
 
 
 Type
 Type
-  TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS,rdoAccessCheckNeedsDB);
+  TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS,rdoAccessCheckNeedsDB,rdoConnectionResource);
   TRestDispatcherOptions = set of TRestDispatcherOption;
   TRestDispatcherOptions = set of TRestDispatcherOption;
 
 
 Const
 Const
@@ -45,6 +45,7 @@ Type
     FPassword: UTF8String;
     FPassword: UTF8String;
     FPort: Word;
     FPort: Word;
     FRole: UTF8String;
     FRole: UTF8String;
+    FSchemaName: UTF8String;
     FUserName: UTF8String;
     FUserName: UTF8String;
     FNotifier : TComponent;
     FNotifier : TComponent;
     function GetName: UTF8String;
     function GetName: UTF8String;
@@ -52,6 +53,8 @@ Type
     procedure SetParams(AValue: TStrings);
     procedure SetParams(AValue: TStrings);
   Protected
   Protected
     Function GetDisplayName: string; override;
     Function GetDisplayName: string; override;
+    // For use in the REST Connection resource
+    Property SchemaName : UTF8String Read FSchemaName Write FSchemaName;
   Public
   Public
     constructor Create(ACollection: TCollection); override;
     constructor Create(ACollection: TCollection); override;
     Destructor Destroy; override;
     Destructor Destroy; override;
@@ -92,9 +95,9 @@ Type
     procedure SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
     procedure SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
   Public
   Public
     // Index of connection by name (case insensitive)
     // Index of connection by name (case insensitive)
-    Function IndexOfConnection(const aName : string) : Integer;
+    Function IndexOfConnection(const aName : UTF8string) : Integer;
     // Find connection by name (case insensitive), nil if none found
     // Find connection by name (case insensitive), nil if none found
-    Function FindConnection(const aName : string) :  TSQLDBRestConnection;
+    Function FindConnection(const aName : UTF8string) :  TSQLDBRestConnection;
     // Add new instance, setting basic properties. Return new instance
     // Add new instance, setting basic properties. Return new instance
     Function AddConnection(Const AType,aHostName,aDatabaseName,aUserName,aPassword : UTF8String) : TSQLDBRestConnection;
     Function AddConnection(Const AType,aHostName,aDatabaseName,aUserName,aPassword : UTF8String) : TSQLDBRestConnection;
     // Save connection definitions to JSON file.
     // Save connection definitions to JSON file.
@@ -142,6 +145,7 @@ Type
     procedure SetSchema(aIndex : Integer; AValue: TSQLDBRestSchemaRef);
     procedure SetSchema(aIndex : Integer; AValue: TSQLDBRestSchemaRef);
   Public
   Public
     Function AddSchema (aSchema : TSQLDBRestSchema) : TSQLDBRestSchemaRef;
     Function AddSchema (aSchema : TSQLDBRestSchema) : TSQLDBRestSchemaRef;
+    Function IndexOfSchema(aSchemaName : String) : Integer;
     Property Schemas[aIndex :Integer] : TSQLDBRestSchemaRef Read GetSchema Write SetSchema;default;
     Property Schemas[aIndex :Integer] : TSQLDBRestSchemaRef Read GetSchema Write SetSchema;default;
   end;
   end;
 
 
@@ -161,6 +165,7 @@ Type
     Class Var FIOClass : TRestIOClass;
     Class Var FIOClass : TRestIOClass;
     Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
     Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
   private
   private
+    FAdminUserIDs: TStrings;
     FCORSAllowCredentials: Boolean;
     FCORSAllowCredentials: Boolean;
     FCORSAllowedOrigins: String;
     FCORSAllowedOrigins: String;
     FCORSMaxAge: Integer;
     FCORSMaxAge: Integer;
@@ -169,6 +174,7 @@ Type
     FCustomViewResource : TSQLDBRestResource;
     FCustomViewResource : TSQLDBRestResource;
     FMetadataResource : TSQLDBRestResource;
     FMetadataResource : TSQLDBRestResource;
     FMetadataDetailResource : TSQLDBRestResource;
     FMetadataDetailResource : TSQLDBRestResource;
+    FConnectionResource : TSQLDBRestResource;
     FActive: Boolean;
     FActive: Boolean;
     FAfterDelete: TRestOperationEvent;
     FAfterDelete: TRestOperationEvent;
     FAfterGet: TRestOperationEvent;
     FAfterGet: TRestOperationEvent;
@@ -195,16 +201,23 @@ Type
     FSchemas: TSQLDBRestSchemaList;
     FSchemas: TSQLDBRestSchemaList;
     FListRoute: THTTPRoute;
     FListRoute: THTTPRoute;
     FItemRoute: THTTPRoute;
     FItemRoute: THTTPRoute;
+    FConnectionsRoute: THTTPRoute;
+    FConnectionItemRoute: THTTPRoute;
+    FMetadataRoute: THTTPRoute;
+    FMetadataItemRoute: THTTPRoute;
     FStatus: TRestStatusConfig;
     FStatus: TRestStatusConfig;
     FStrings: TRestStringsConfig;
     FStrings: TRestStringsConfig;
     procedure SetActive(AValue: Boolean);
     procedure SetActive(AValue: Boolean);
+    procedure SetAdminUserIDS(AValue: TStrings);
     procedure SetAuthenticator(AValue: TRestAuthenticator);
     procedure SetAuthenticator(AValue: TRestAuthenticator);
     procedure SetConnections(AValue: TSQLDBRestConnectionList);
     procedure SetConnections(AValue: TSQLDBRestConnectionList);
+    procedure SetDispatchOptions(AValue: TRestDispatcherOptions);
     procedure SetSchemas(AValue: TSQLDBRestSchemaList);
     procedure SetSchemas(AValue: TSQLDBRestSchemaList);
     procedure SetStatus(AValue: TRestStatusConfig);
     procedure SetStatus(AValue: TRestStatusConfig);
     procedure SetStrings(AValue: TRestStringsConfig);
     procedure SetStrings(AValue: TRestStringsConfig);
   Protected
   Protected
     // Auxiliary methods.
     // Auxiliary methods.
+    Procedure Loaded; override;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     function FindConnection(IO: TRestIO): TSQLDBRestConnection;
     function FindConnection(IO: TRestIO): TSQLDBRestConnection;
     // Factory methods. Override these to customize various helper classes.
     // Factory methods. Override these to customize various helper classes.
@@ -222,6 +235,13 @@ Type
     function GetConnectionName(IO: TRestIO): UTF8String;
     function GetConnectionName(IO: TRestIO): UTF8String;
     function GetSQLConnection(aConnection: TSQLDBRestConnection; Out aTransaction : TSQLTransaction): TSQLConnection; virtual;
     function GetSQLConnection(aConnection: TSQLDBRestConnection; Out aTransaction : TSQLTransaction): TSQLConnection; virtual;
     procedure DoneSQLConnection(aConnection: TSQLDBRestConnection; AConn: TSQLConnection; aTransaction : TSQLTransaction); virtual;
     procedure DoneSQLConnection(aConnection: TSQLDBRestConnection; AConn: TSQLConnection; aTransaction : TSQLTransaction); virtual;
+    // Connections dataset API
+    procedure ConnectionsToDataset(D: TDataset); virtual;
+    procedure DoConnectionDelete(DataSet: TDataSet); virtual;
+    procedure DoConnectionPost(DataSet: TDataSet);virtual;
+    procedure DatasetToConnection(D: TDataset; C: TSQLDBRestConnection); virtual;
+    procedure ConnectionToDataset(C: TSQLDBRestConnection; D: TDataset); virtual;
+    procedure DoConnectionResourceAllowed(aSender: TObject; aContext: TBaseRestContext; var allowResource: Boolean);
     // Error handling
     // Error handling
     procedure CreateErrorContent(IO: TRestIO; aCode: Integer; AExtraMessage: UTF8String); virtual;
     procedure CreateErrorContent(IO: TRestIO; aCode: Integer; AExtraMessage: UTF8String); virtual;
     procedure HandleException(E: Exception; IO: TRestIO); virtual;
     procedure HandleException(E: Exception; IO: TRestIO); virtual;
@@ -245,8 +265,10 @@ Type
     // Special resources for Metadata handling
     // Special resources for Metadata handling
     function CreateMetadataDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
     function CreateMetadataDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
     function CreateMetadataDetailDataset(IO: TRestIO; Const aResourceName : String; AOwner: TComponent): TDataset; virtual;
     function CreateMetadataDetailDataset(IO: TRestIO; Const aResourceName : String; AOwner: TComponent): TDataset; virtual;
+    function CreateConnectionDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
     function CreateMetadataDetailResource: TSQLDBRestResource;  virtual;
     function CreateMetadataDetailResource: TSQLDBRestResource;  virtual;
     function CreateMetadataResource: TSQLDBRestResource; virtual;
     function CreateMetadataResource: TSQLDBRestResource; virtual;
+    Function CreateConnectionResource : TSQLDBRestResource; virtual;
     // Custom view handling
     // Custom view handling
     function CreateCustomViewResource: TSQLDBRestResource; virtual;
     function CreateCustomViewResource: TSQLDBRestResource; virtual;
     function CreateCustomViewDataset(IO: TRestIO; const aSQL: String; AOwner: TComponent): TDataset;
     function CreateCustomViewDataset(IO: TRestIO; const aSQL: String; AOwner: TComponent): TDataset;
@@ -266,6 +288,8 @@ Type
     Destructor Destroy; override;
     Destructor Destroy; override;
     procedure RegisterRoutes;
     procedure RegisterRoutes;
     procedure UnRegisterRoutes;
     procedure UnRegisterRoutes;
+    procedure HandleMetadataRequest(aRequest : TRequest; aResponse : TResponse);
+    procedure HandleConnRequest(aRequest : TRequest; aResponse : TResponse);
     procedure HandleRequest(aRequest : TRequest; aResponse : TResponse);
     procedure HandleRequest(aRequest : TRequest; aResponse : TResponse);
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : Array of String; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : Array of String; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
@@ -281,6 +305,8 @@ Type
     // Base URL
     // Base URL
     property BasePath : UTF8String Read FBaseURL Write FBaseURL;
     property BasePath : UTF8String Read FBaseURL Write FBaseURL;
     // Default connection to use if none is detected from request/schema
     // Default connection to use if none is detected from request/schema
+    // This connection will also be used to authenticate the user for connection API,
+    // so it must be set if you use SQL to authenticate the user.
     Property DefaultConnection : UTF8String Read FDefaultConnection Write FDefaultConnection;
     Property DefaultConnection : UTF8String Read FDefaultConnection Write FDefaultConnection;
     // Input/Output strings configuration
     // Input/Output strings configuration
     Property Strings : TRestStringsConfig Read FStrings Write SetStrings;
     Property Strings : TRestStringsConfig Read FStrings Write SetStrings;
@@ -293,7 +319,7 @@ Type
     // Set this to allow only this output format.
     // Set this to allow only this output format.
     Property OutputFormat : String Read FOutputFormat Write FOutputFormat;
     Property OutputFormat : String Read FOutputFormat Write FOutputFormat;
     // Dispatcher options
     // Dispatcher options
-    Property DispatchOptions : TRestDispatcherOptions Read FDispatchOptions Write FDispatchOptions default DefaultDispatcherOptions;
+    Property DispatchOptions : TRestDispatcherOptions Read FDispatchOptions Write SetDispatchOptions default DefaultDispatcherOptions;
     // Authenticator for requests
     // Authenticator for requests
     Property Authenticator : TRestAuthenticator Read FAuthenticator Write SetAuthenticator;
     Property Authenticator : TRestAuthenticator Read FAuthenticator Write SetAuthenticator;
     // If >0, Enforce a limit on output results.
     // If >0, Enforce a limit on output results.
@@ -304,6 +330,8 @@ Type
     Property CORSMaxAge : Integer Read FCORSMaxAge Write FCORSMaxAge;
     Property CORSMaxAge : Integer Read FCORSMaxAge Write FCORSMaxAge;
     // Access-Control-Allow-Credentials header value. Set to zero not to send the header
     // Access-Control-Allow-Credentials header value. Set to zero not to send the header
     Property CORSAllowCredentials : Boolean Read FCORSAllowCredentials Write FCORSAllowCredentials;
     Property CORSAllowCredentials : Boolean Read FCORSAllowCredentials Write FCORSAllowCredentials;
+    // UserIDs of the user(s) that are allowed to see and modify the connection resource.
+    Property AdminUserIDs : TStrings Read FAdminUserIDs Write SetAdminUserIDS;
     // Called when Basic authentication is sufficient.
     // Called when Basic authentication is sufficient.
     Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
     Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
     // Allow a particular resource or not.
     // Allow a particular resource or not.
@@ -406,6 +434,13 @@ begin
   Result.Enabled:=True;
   Result.Enabled:=True;
 end;
 end;
 
 
+function TSQLDBRestSchemaList.IndexOfSchema(aSchemaName: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and Not (Assigned(GetSchema(Result).Schema) and SameText(GetSchema(Result).Schema.Name,aSchemaName)) do
+    Dec(Result);
+end;
+
 { TSQLDBRestDispatcher }
 { TSQLDBRestDispatcher }
 
 
 procedure TSQLDBRestDispatcher.SetConnections(AValue: TSQLDBRestConnectionList);
 procedure TSQLDBRestDispatcher.SetConnections(AValue: TSQLDBRestConnectionList);
@@ -414,15 +449,39 @@ begin
   FConnections.Assign(AValue);
   FConnections.Assign(AValue);
 end;
 end;
 
 
+procedure TSQLDBRestDispatcher.SetDispatchOptions(AValue: TRestDispatcherOptions);
+
+begin
+  if (rdoConnectionResource in aValue) then
+    Include(aValue,rdoConnectionInURL);
+  if FDispatchOptions=AValue then Exit;
+  FDispatchOptions:=AValue;
+end;
+
+procedure TSQLDBRestDispatcher.DoConnectionResourceAllowed(aSender: TObject;
+  aContext: TBaseRestContext; var allowResource: Boolean);
+begin
+  AllowResource:=(AdminUserIDs.Count=0) or  (AdminUserIDs.IndexOf(aContext.UserID)<>-1);
+end;
+
 procedure TSQLDBRestDispatcher.SetActive(AValue: Boolean);
 procedure TSQLDBRestDispatcher.SetActive(AValue: Boolean);
 begin
 begin
-  if FActive=AValue then Exit;
-  if AValue then
-    DoRegisterRoutes
-  else
-    UnRegisterRoutes;
+  if FActive=AValue then
+    Exit;
+  if Not (csLoading in ComponentState) then
+    begin
+    if AValue then
+      DoRegisterRoutes
+    else
+      UnRegisterRoutes;
+    end;
   FActive:=AValue;
   FActive:=AValue;
+end;
 
 
+procedure TSQLDBRestDispatcher.SetAdminUserIDS(AValue: TStrings);
+begin
+  if FAdminUserIDs=AValue then Exit;
+  FAdminUserIDs.Assign(AValue);
 end;
 end;
 
 
 procedure TSQLDBRestDispatcher.SetAuthenticator(AValue: TRestAuthenticator);
 procedure TSQLDBRestDispatcher.SetAuthenticator(AValue: TRestAuthenticator);
@@ -453,18 +512,51 @@ begin
   FStrings.Assign(AValue);
   FStrings.Assign(AValue);
 end;
 end;
 
 
+procedure TSQLDBRestDispatcher.Loaded;
+begin
+  inherited Loaded;
+  if FActive then
+    RegisterRoutes;
+end;
+
+procedure TSQLDBRestDispatcher.HandleConnRequest(aRequest : TRequest; aResponse : TResponse);
+
+begin
+  aRequest.RouteParams['resource']:=Strings.ConnectionResourceName;
+  HandleRequest(aRequest,aResponse);
+end;
+
+procedure TSQLDBRestDispatcher.HandleMetadataRequest(aRequest: TRequest;
+  aResponse: TResponse);
+begin
+  aRequest.RouteParams['resource']:=Strings.MetadataResourceName;
+  HandleRequest(aRequest,aResponse);
+end;
+
 procedure TSQLDBRestDispatcher.DoRegisterRoutes;
 procedure TSQLDBRestDispatcher.DoRegisterRoutes;
 
 
 Var
 Var
-  Res : String;
+  Res,C : UTF8String;
 
 
 begin
 begin
   Res:=IncludeHTTPPathDelimiter(BasePath);
   Res:=IncludeHTTPPathDelimiter(BasePath);
-  if rdoConnectionInURL in DispatchOptions then
+  if (rdoConnectionResource in DispatchOptions) then
+    begin
+    C:=Strings.GetRestString(rpConnectionResourceName);
+    FConnectionsRoute:=HTTPRouter.RegisterRoute(res+C,@HandleConnRequest);
+    FConnectionItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleConnRequest);
+    end;
+  if (rdoConnectionInURL in DispatchOptions) then
+    begin
+    C:=Strings.GetRestString(rpMetadataResourceName);
+    FMetadataRoute:=HTTPRouter.RegisterRoute(res+C,@HandleMetaDataRequest);
+    FMetadataItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleMetaDataRequest);
     Res:=Res+':connection/';
     Res:=Res+':connection/';
+    end;
   Res:=Res+':resource';
   Res:=Res+':resource';
   FListRoute:=HTTPRouter.RegisterRoute(res,@HandleRequest);
   FListRoute:=HTTPRouter.RegisterRoute(res,@HandleRequest);
   FItemRoute:=HTTPRouter.RegisterRoute(Res+'/:id',@HandleRequest);
   FItemRoute:=HTTPRouter.RegisterRoute(Res+'/:id',@HandleRequest);
+
 end;
 end;
 
 
 function TSQLDBRestDispatcher.GetInputFormat(IO : TRestIO) : String;
 function TSQLDBRestDispatcher.GetInputFormat(IO : TRestIO) : String;
@@ -633,14 +725,17 @@ begin
   FStatus:=CreateRestStatusConfig;
   FStatus:=CreateRestStatusConfig;
   FCORSMaxAge:=SecsPerDay;
   FCORSMaxAge:=SecsPerDay;
   FCORSAllowCredentials:=True;
   FCORSAllowCredentials:=True;
+  FAdminUserIDs:=TStringList.Create;
 end;
 end;
 
 
 destructor TSQLDBRestDispatcher.Destroy;
 destructor TSQLDBRestDispatcher.Destroy;
 begin
 begin
   Authenticator:=Nil;
   Authenticator:=Nil;
+  FreeAndNil(FAdminUserIDs);
   FreeAndNil(FCustomViewResource);
   FreeAndNil(FCustomViewResource);
   FreeAndNil(FMetadataResource);
   FreeAndNil(FMetadataResource);
   FreeAndNil(FMetadataDetailResource);
   FreeAndNil(FMetadataDetailResource);
+  FreeAndNil(FConnectionResource);
   FreeAndNil(FSchemas);
   FreeAndNil(FSchemas);
   FreeAndNil(FConnections);
   FreeAndNil(FConnections);
   FreeAndNil(FStrings);
   FreeAndNil(FStrings);
@@ -692,13 +787,13 @@ Var
 
 
 begin
 begin
   Result:=TSQLDBRestResource.Create(Nil);
   Result:=TSQLDBRestResource.Create(Nil);
-  Result.ResourceName:='metaData';
+  Result.ResourceName:=Strings.GetRestString(rpMetadataResourceName);
   if rdoHandleCORS in DispatchOptions then
   if rdoHandleCORS in DispatchOptions then
     Result.AllowedOperations:=[roGet,roOptions,roHead]
     Result.AllowedOperations:=[roGet,roOptions,roHead]
   else
   else
     Result.AllowedOperations:=[roGet,roHead];
     Result.AllowedOperations:=[roGet,roHead];
-  Result.Fields.AddField('name',rftString,[foRequired]);
-  Result.Fields.AddField('schemaName',rftString,[foRequired]);
+  Result.Fields.AddField('name',rftString,[foRequired]).MaxLen:=255;
+  Result.Fields.AddField('schemaName',rftString,[foRequired]).MaxLen:=255;
   for O in TRestOperation do
   for O in TRestOperation do
     if O<>roUnknown then
     if O<>roUnknown then
       begin
       begin
@@ -708,6 +803,34 @@ begin
       end;
       end;
 end;
 end;
 
 
+function TSQLDBRestDispatcher.CreateConnectionResource: TSQLDBRestResource;
+Var
+  O : TRestOperation;
+  S : String;
+  Def : TRestFieldOptions;
+
+begin
+  Def:=[foInInsert,foInUpdate,foFilter];
+  Result:=TSQLDBRestResource.Create(Nil);
+  Result.ResourceName:=Strings.GetRestString(rpConnectionResourceName);
+  Result.AllowedOperations:=[roGet,roPut,roPost,roDelete];
+  if rdoHandleCORS in DispatchOptions then
+    Result.AllowedOperations:=Result.AllowedOperations+[roOptions,roHead];
+  Result.Fields.AddField('name',rftString,Def+[foInKey,foRequired]);
+  Result.Fields.AddField('dbType',rftString,Def+[foRequired]);
+  Result.Fields.AddField('dbName',rftString,Def+[foRequired]);
+  Result.Fields.AddField('dbHostName',rftString,Def);
+  Result.Fields.AddField('dbUserName',rftString,Def);
+  Result.Fields.AddField('dbPassword',rftString,Def);
+  Result.Fields.AddField('dbCharSet',rftString,Def);
+  Result.Fields.AddField('dbRole',rftString,Def);
+  Result.Fields.AddField('dbPort',rftInteger,Def);
+  Result.Fields.AddField('enabled',rftBoolean,Def);
+  Result.Fields.AddField('expose',rftBoolean,Def);
+  Result.Fields.AddField('exposeSchemaName',rftString,Def);
+  Result.OnResourceAllowed:=@DoConnectionResourceAllowed;
+end;
+
 function TSQLDBRestDispatcher.CreateMetadataDetailResource: TSQLDBRestResource;
 function TSQLDBRestDispatcher.CreateMetadataDetailResource: TSQLDBRestResource;
 
 
 Var
 Var
@@ -721,10 +844,10 @@ begin
     Result.AllowedOperations:=[roGet,roOptions,roHead]
     Result.AllowedOperations:=[roGet,roOptions,roHead]
   else
   else
     Result.AllowedOperations:=[roGet,roHead];
     Result.AllowedOperations:=[roGet,roHead];
-  Result.Fields.AddField('name',rftString,[]);
-  Result.Fields.AddField('type',rftString,[]);
+  Result.Fields.AddField('name',rftString,[]).MaxLen:=255;
+  Result.Fields.AddField('type',rftString,[]).MaxLen:=20;
   Result.Fields.AddField('maxlen',rftInteger,[]);
   Result.Fields.AddField('maxlen',rftInteger,[]);
-  Result.Fields.AddField('format',rftString,[]);
+  Result.Fields.AddField('format',rftString,[]).MaxLen:=50;
   for O in TRestFieldOption do
   for O in TRestFieldOption do
     begin
     begin
     Str(O,S);
     Str(O,S);
@@ -741,6 +864,7 @@ function TSQLDBRestDispatcher.FindSpecialResource(IO : TRestIO; aResource: UTF8S
     Result:=(rdoCustomView in DispatchOptions)
     Result:=(rdoCustomView in DispatchOptions)
             and SameText(aResource,Strings.GetRestString(rpCustomViewResourceName));
             and SameText(aResource,Strings.GetRestString(rpCustomViewResourceName));
   end;
   end;
+
   Function IsMetadata : Boolean;inline;
   Function IsMetadata : Boolean;inline;
 
 
   begin
   begin
@@ -748,6 +872,13 @@ function TSQLDBRestDispatcher.FindSpecialResource(IO : TRestIO; aResource: UTF8S
             and SameText(aResource,Strings.GetRestString(rpMetaDataResourceName));
             and SameText(aResource,Strings.GetRestString(rpMetaDataResourceName));
   end;
   end;
 
 
+  Function IsConnection : Boolean;inline;
+
+  begin
+    Result:=(rdoConnectionResource in DispatchOptions)
+            and SameText(aResource,Strings.GetRestString(rpConnectionResourceName));
+  end;
+
 Var
 Var
   N : UTF8String;
   N : UTF8String;
 
 
@@ -759,6 +890,12 @@ begin
       FCustomViewResource:=CreateCustomViewResource;
       FCustomViewResource:=CreateCustomViewResource;
     Result:=FCustomViewResource;
     Result:=FCustomViewResource;
     end
     end
+  else if IsConnection then
+    begin
+    if FConnectionResource=Nil then
+      FConnectionResource:=CreateConnectionResource;
+    Result:=FConnectionResource;
+    end
   else If isMetadata then
   else If isMetadata then
     if (IO.GetVariable('ID',N,[vsRoute,vsQuery])=vsNone) then
     if (IO.GetVariable('ID',N,[vsRoute,vsQuery])=vsNone) then
       begin
       begin
@@ -775,7 +912,6 @@ begin
         Result:=FMetadataDetailResource;
         Result:=FMetadataDetailResource;
         end;
         end;
       end
       end
-
 end;
 end;
 
 
 function TSQLDBRestDispatcher.FindRestResource(aResource: UTF8String): TSQLDBRestResource;
 function TSQLDBRestDispatcher.FindRestResource(aResource: UTF8String): TSQLDBRestResource;
@@ -872,6 +1008,10 @@ function TSQLDBRestDispatcher.GetSQLConnection(
   ): TSQLConnection;
   ): TSQLConnection;
 
 
 begin
 begin
+  Result:=Nil;
+  aTransaction:=Nil;
+  if aConnection=Nil then
+    exit;
   Result:=aConnection.SingleConnection;
   Result:=aConnection.SingleConnection;
   if (Result=Nil) then
   if (Result=Nil) then
     begin
     begin
@@ -973,6 +1113,7 @@ begin
   if not Result then exit;
   if not Result then exit;
   Result:=(aResource=FMetadataResource) or
   Result:=(aResource=FMetadataResource) or
           (aResource=FMetadataDetailResource) or
           (aResource=FMetadataDetailResource) or
+          (aResource=FConnectionResource) or
           (aResource=FCustomViewResource);
           (aResource=FCustomViewResource);
 end;
 end;
 
 
@@ -1124,6 +1265,166 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TSQLDBRestDispatcher.DatasetToConnection(D: TDataset; C : TSQLDBRestConnection);
+
+begin
+  C.Name:=UTF8Encode(D.FieldByName('name').AsWideString);
+  C.ConnectionType:=D.FieldByName('dbType').AsString;
+  C.DatabaseName:=UTF8Encode(D.FieldByName('dbName').AsWideString);
+  C.HostName:=D.FieldByName('dbHostName').AsString;
+  C.UserName:=UTF8Encode(D.FieldByName('dbUserName').AsWideString);
+  C.Password:=UTF8Encode(D.FieldByName('dbPassword').AsWideString);
+  C.CharSet:=D.FieldByName('dbCharSet').AsString;
+  C.Role:=D.FieldByName('dbRole').AsString;
+  C.Port:=D.FieldByName('dbPort').AsInteger;
+  C.Enabled:=D.FieldByName('enabled').AsBoolean;
+  if D.FieldByName('expose').AsBoolean then
+    C.SchemaName:=D.FieldByName('exposeSchemaName').AsString;
+end;
+
+procedure TSQLDBRestDispatcher.ConnectionToDataset(C : TSQLDBRestConnection;D: TDataset);
+
+begin
+  D.FieldByName('key').AsWideString:=UTF8Decode(C.Name);
+  D.FieldByName('name').AsWideString:=UTF8Decode(C.Name);
+  D.FieldByName('dbType').AsString:=C.ConnectionType;
+  D.FieldByName('dbName').AsWideString:=UTF8Decode(C.DatabaseName);
+  D.FieldByName('dbHostName').AsString:=C.HostName;
+  D.FieldByName('dbUserName').AsWideString:=UTF8Decode(C.UserName);
+  D.FieldByName('dbPassword').AsWideString:=UTF8Decode(C.Password);
+  D.FieldByName('dbCharSet').AsString:=C.CharSet;
+  D.FieldByName('dbRole').AsString:=C.Role;
+  D.FieldByName('dbPort').AsInteger:=C.Port;
+  D.FieldByName('enabled').AsBoolean:=C.Enabled;
+  D.FieldByName('expose').AsBoolean:=(C.SchemaName<>'');
+  D.FieldByName('exposeSchemaName').AsString:=C.SchemaName;
+end;
+
+procedure TSQLDBRestDispatcher.ConnectionsToDataset(D: TDataset);
+
+Var
+  C : TSQLDBRestConnection;
+  I : Integer;
+
+begin
+  For I:=0 to Connections.Count-1 do
+    begin
+    C:=Connections[i];
+    D.Append;
+    ConnectionToDataset(C,D);
+    D.Post;
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.DoConnectionDelete(DataSet: TDataSet);
+
+Var
+  I,J : Integer;
+  C : TSQLDBRestConnection;
+
+
+begin
+  I:=Connections.IndexOfConnection(UTF8Encode(Dataset.FieldByName('name').AsWideString));
+  if I<>-1 then
+    begin
+    C:=Connections[i];
+    if C.SingleConnection<>Nil then
+      DoneSQLConnection(C,C.SingleConnection,Nil);
+    if C.SchemaName<>'' then
+      begin
+      J:=Schemas.IndexOfSchema(C.SchemaName);
+      if J<>-1 then
+        begin
+        Schemas[J].Schema.Free;
+        Schemas[J].Schema:=Nil;
+        end;
+      Schemas.Delete(J);
+      end;
+    Connections.Delete(I);
+    end
+  else
+    Raise ESQLDBRest.Create(404,'NOT FOUND');
+end;
+
+procedure TSQLDBRestDispatcher.DoConnectionPost(DataSet: TDataSet);
+
+Var
+  isNew : Boolean;
+  C : TSQLDBRestConnection;
+  N : UTF8String;
+  UN : UnicodeString;
+  S : TSQLDBRestSchema;
+  Conn : TSQLConnection;
+
+begin
+  IsNew:=Dataset.State=dsInsert;
+  if IsNew then
+    C:=Connections.Add as TSQLDBRestConnection
+  else
+    begin
+    UN:=Dataset.FieldByName('key').AsString;
+//    C:=Connections[Dataset.RecNo-1];
+    C:=Connections.FindConnection(Utf8Encode(UN));
+    if (C=Nil) then
+      Raise ESQLDBRest.Create(404,'NOT FOUND');
+    end;
+  if Assigned(C.SingleConnection) then
+    DoneSQLConnection(C,C.SingleConnection,Nil);
+  DatasetToConnection(Dataset,C);
+  if (Dataset.FieldByName('expose').AsBoolean) and isNew then
+    begin
+    N:=C.SchemaName;
+    if N='' then
+      N:=C.Name+'schema';
+    if (Schemas.IndexOfSchema(N)<>-1) then
+      Raise ESQLDBRest.Create(400,'DUPLICATE SCHEMA');
+    try
+      S:=ExposeConnection(C,Nil);
+    except
+      if IsNew then
+        C.Free;
+      Raise;
+    end;
+    S.Name:=N;
+    end;
+end;
+
+function TSQLDBRestDispatcher.CreateConnectionDataset(IO: TRestIO; AOwner: TComponent): TDataset;
+Var
+  BD :  TRestBufDataset;
+
+begin
+  if IO=Nil then exit;
+  BD:=TRestBufDataset.Create(aOwner);
+  try
+    Result:=BD;
+    // Key field is not exposed
+    Result.FieldDefs.add('key',ftWidestring,255);
+    Result.FieldDefs.add('name',ftWidestring,255);
+    Result.FieldDefs.add('dbType',ftString,20);
+    Result.FieldDefs.add('dbName',ftWideString,255);
+    Result.FieldDefs.add('dbHostName',ftString,255);
+    Result.FieldDefs.add('dbUserName',ftWideString,255);
+    Result.FieldDefs.add('dbPassword',ftWideString,255);
+    Result.FieldDefs.add('dbCharSet',ftString,50);
+    Result.FieldDefs.add('dbRole',ftString,255);
+    Result.FieldDefs.add('dbPort',ftInteger,0);
+    Result.FieldDefs.add('enabled',ftBoolean,0);
+    Result.FieldDefs.add('expose',ftBoolean,0);
+    Result.FieldDefs.add('exposeSchemaName',ftWideString,255);
+    BD.CreateDataset;
+    ConnectionsToDataset(BD);
+    BD.IndexDefs.Add('uName','name',[ixUnique]);
+    BD.IndexName:='uName';
+    BD.First;
+    BD.BeforePost:=@DoConnectionPost;
+    BD.BeforeDelete:=@DoConnectionDelete;
+  except
+    BD.Free;
+    Raise;
+  end;
+end;
+
 function TSQLDBRestDispatcher.CreateCustomViewDataset(IO: TRestIO;
 function TSQLDBRestDispatcher.CreateCustomViewDataset(IO: TRestIO;
   const aSQL: String; AOwner: TComponent): TDataset;
   const aSQL: String; AOwner: TComponent): TDataset;
 
 
@@ -1159,6 +1460,8 @@ begin
   Result:=Nil;
   Result:=Nil;
   if (IO.Resource=FMetadataResource) then
   if (IO.Resource=FMetadataResource) then
     Result:=CreateMetadataDataset(IO,AOwner)
     Result:=CreateMetadataDataset(IO,AOwner)
+  else if (IO.Resource=FConnectionResource) then
+    Result:=CreateConnectionDataset(IO,AOwner)
   else if (IO.Resource=FMetadataDetailResource) then
   else if (IO.Resource=FMetadataDetailResource) then
     begin
     begin
     if IO.GetVariable('ID',RN,[vsRoute,vsQuery])=vsNone then
     if IO.GetVariable('ID',RN,[vsRoute,vsQuery])=vsNone then
@@ -1220,6 +1523,7 @@ Var
   H : TSQLDBRestDBHandler;
   H : TSQLDBRestDBHandler;
   l,o : Int64;
   l,o : Int64;
 
 
+
 begin
 begin
   H:=Nil;
   H:=Nil;
   Conn:=GetSQLConnection(aConnection,Tr);
   Conn:=GetSQLConnection(aConnection,Tr);
@@ -1243,7 +1547,8 @@ begin
         end;
         end;
       H.ExecuteOperation;
       H.ExecuteOperation;
       DoHandleEvent(False,IO);
       DoHandleEvent(False,IO);
-      tr.Commit;
+      if Assigned(TR) then
+        TR.Commit;
       SetDefaultResponseCode(IO);
       SetDefaultResponseCode(IO);
     except
     except
       TR.RollBack;
       TR.RollBack;
@@ -1365,7 +1670,7 @@ begin
         begin
         begin
         IO.SetResource(Resource);
         IO.SetResource(Resource);
         Connection:=FindConnection(IO);
         Connection:=FindConnection(IO);
-        if Connection=Nil then
+        if (Connection=Nil) and not IsSpecialResource(Resource) then
           begin
           begin
           if (rdoConnectionInURL in DispatchOptions) then
           if (rdoConnectionInURL in DispatchOptions) then
             CreateErrorContent(IO,FStatus.GetStatusCode(rsNoConnectionSpecified),Format(SErrNoconnection,[GetConnectionName(IO)]))
             CreateErrorContent(IO,FStatus.GetStatusCode(rsNoConnectionSpecified),Format(SErrNoconnection,[GetConnectionName(IO)]))
@@ -1396,8 +1701,13 @@ procedure TSQLDBRestDispatcher.UnRegisterRoutes;
 begin
 begin
   Un(FListRoute);
   Un(FListRoute);
   Un(FItemRoute);
   Un(FItemRoute);
+  Un(FConnectionItemRoute);
+  Un(FConnectionsRoute);
+  Un(FMetadataItemRoute);
+  Un(FMetadataRoute);
 end;
 end;
 
 
+
 procedure TSQLDBRestDispatcher.RegisterRoutes;
 procedure TSQLDBRestDispatcher.RegisterRoutes;
 begin
 begin
   if (FListRoute<>Nil) then
   if (FListRoute<>Nil) then
@@ -1651,7 +1961,7 @@ begin
   Items[aIndex]:=aValue;
   Items[aIndex]:=aValue;
 end;
 end;
 
 
-function TSQLDBRestConnectionList.IndexOfConnection(const aName: string
+function TSQLDBRestConnectionList.IndexOfConnection(const aName: UTF8string
   ): Integer;
   ): Integer;
 begin
 begin
   Result:=Count-1;
   Result:=Count-1;
@@ -1659,7 +1969,7 @@ begin
     Dec(Result);
     Dec(Result);
 end;
 end;
 
 
-function TSQLDBRestConnectionList.FindConnection(const aName: string): TSQLDBRestConnection;
+function TSQLDBRestConnectionList.FindConnection(const aName: UTF8string): TSQLDBRestConnection;
 Var
 Var
   Idx : Integer;
   Idx : Integer;
 
 
@@ -1849,6 +2159,8 @@ begin
     Role:=C.Role;
     Role:=C.Role;
     DatabaseName:=C.DatabaseName;
     DatabaseName:=C.DatabaseName;
     ConnectionType:=C.ConnectionType;
     ConnectionType:=C.ConnectionType;
+    Port:=C.Port;
+    SchemaName:=C.SchemaName;
     Params.Assign(C.Params);
     Params.Assign(C.Params);
     end
     end
   else
   else

+ 223 - 69
packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -47,11 +47,14 @@ Type
     FResource : TSQLDBRestResource;
     FResource : TSQLDBRestResource;
     FOwnsResource : Boolean;
     FOwnsResource : Boolean;
     procedure SetExternalDataset(AValue: TDataset);
     procedure SetExternalDataset(AValue: TDataset);
-    function StreamRecord(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray): Boolean;
   Protected
   Protected
+    function StreamRecord(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray): Boolean; virtual;
+    function FindExistingRecord(D: TDataset): Boolean;
     procedure CreateResourceFromDataset(D: TDataset); virtual;
     procedure CreateResourceFromDataset(D: TDataset); virtual;
     procedure DoNotFound; virtual;
     procedure DoNotFound; virtual;
     procedure SetPostParams(aParams: TParams; Old : TFields = Nil);virtual;
     procedure SetPostParams(aParams: TParams; Old : TFields = Nil);virtual;
+    procedure SetPostFields(aFields: TFields);virtual;
+    procedure SetFieldFromData(DataField: TField; ResField: TSQLDBRestField; D: TJSONData); virtual;
     procedure InsertNewRecord; virtual;
     procedure InsertNewRecord; virtual;
     procedure UpdateExistingRecord(OldData: TDataset); virtual;
     procedure UpdateExistingRecord(OldData: TDataset); virtual;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -81,7 +84,7 @@ Type
     Function GetLimitOffset(out aLimit, aOffset: Int64) : Boolean; virtual;
     Function GetLimitOffset(out aLimit, aOffset: Int64) : Boolean; virtual;
     Procedure Init(aIO: TRestIO; aStrings : TRestStringsConfig;AQueryClass : TSQLQueryClass); virtual;
     Procedure Init(aIO: TRestIO; aStrings : TRestStringsConfig;AQueryClass : TSQLQueryClass); virtual;
     Procedure ExecuteOperation;
     Procedure ExecuteOperation;
-    Function StreamDataset(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray) : Int64;
+    Function StreamDataset(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray; CurrentOnly : Boolean = False) : Int64;
     procedure SetParamFromData(P: TParam; F: TSQLDBRestField; D: TJSONData); virtual;
     procedure SetParamFromData(P: TParam; F: TSQLDBRestField; D: TJSONData); virtual;
     function GetDataForParam(P: TParam; F: TSQLDBRestField; Sources : TVariableSources = AllVariableSources): TJSONData; virtual;
     function GetDataForParam(P: TParam; F: TSQLDBRestField; Sources : TVariableSources = AllVariableSources): TJSONData; virtual;
     Function GetString(aString : TRestStringProperty) : UTF8String;
     Function GetString(aString : TRestStringProperty) : UTF8String;
@@ -98,7 +101,7 @@ Type
 
 
 implementation
 implementation
 
 
-uses strutils, dateutils, base64, sqldbrestconst;
+uses strutils, variants, dateutils, base64, sqldbrestconst;
 
 
 
 
 Const
 Const
@@ -170,7 +173,8 @@ begin
     end;
     end;
 end;
 end;
 
 
-function TSQLDBRestDBHandler.GetWhere(Out FilteredFields : TRestFilterPairArray): UTF8String;
+function TSQLDBRestDBHandler.GetWhere(out FilteredFields: TRestFilterPairArray
+  ): UTF8String;
 
 
 Const
 Const
   MaxFilterCount = 1+ Ord(High(TRestFieldFilter)) - Ord(Low(TRestFieldFilter));
   MaxFilterCount = 1+ Ord(High(TRestFieldFilter)) - Ord(Low(TRestFieldFilter));
@@ -350,7 +354,8 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.GetDataForParam(P : TParam; F : TSQLDBRestField; Sources : TVariableSources = AllVariableSources) : TJSONData;
+function TSQLDBRestDBHandler.GetDataForParam(P: TParam; F: TSQLDBRestField;
+  Sources: TVariableSources): TJSONData;
 
 
 Var
 Var
   vs : TVariableSource;
   vs : TVariableSource;
@@ -380,7 +385,8 @@ begin
     end;
     end;
 end;
 end;
 
 
-Procedure TSQLDBRestDBHandler.SetParamFromData(P : TParam; F : TSQLDBRestField; D : TJSONData);
+procedure TSQLDBRestDBHandler.SetParamFromData(P: TParam; F: TSQLDBRestField;
+  D: TJSONData);
 
 
 begin
 begin
   if not Assigned(D) then
   if not Assigned(D) then
@@ -408,7 +414,8 @@ begin
     P.AsString:=D.AsString;
     P.AsString:=D.AsString;
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.FindFieldForParam(aOperation : TRestOperation; P : TParam) : TSQLDBRestField;
+function TSQLDBRestDBHandler.FindFieldForParam(aOperation: TRestOperation;
+  P: TParam): TSQLDBRestField;
 
 
 Var
 Var
   N : UTF8String;
   N : UTF8String;
@@ -490,13 +497,14 @@ begin
     end;
     end;
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.GetLimitOffset(Out aLimit,aOffset : Int64) : Boolean;
+function TSQLDBRestDBHandler.GetLimitOffset(out aLimit, aOffset: Int64
+  ): Boolean;
 
 
 begin
 begin
   Result:=IO.GetLimitOffset(EnforceLimit,aLimit,aoffset);
   Result:=IO.GetLimitOffset(EnforceLimit,aLimit,aoffset);
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.GetLimit : UTF8String;
+function TSQLDBRestDBHandler.GetLimit: UTF8String;
 
 
 var
 var
   aOffset, aLimit : Int64;
   aOffset, aLimit : Int64;
@@ -526,7 +534,8 @@ begin
 end;
 end;
 
 
 
 
-Function TSQLDBRestDBHandler.StreamRecord(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Boolean;
+function TSQLDBRestDBHandler.StreamRecord(O: TRestOutputStreamer; D: TDataset;
+  FieldList: TRestFieldPairArray): Boolean;
 
 
 Var
 Var
   i : Integer;
   i : Integer;
@@ -541,7 +550,8 @@ begin
   O.EndRow;
   O.EndRow;
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.StreamDataset(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Int64;
+function TSQLDBRestDBHandler.StreamDataset(O: TRestOutputStreamer; D: TDataset;
+  FieldList: TRestFieldPairArray; CurrentOnly : Boolean = False): Int64;
 
 
 Var
 Var
   aLimit,aOffset : Int64;
   aLimit,aOffset : Int64;
@@ -569,25 +579,31 @@ begin
   if O.HasOption(ooMetadata) then
   if O.HasOption(ooMetadata) then
     O.WriteMetadata(FieldList);
     O.WriteMetadata(FieldList);
   O.StartData;
   O.StartData;
-  if EmulateOffsetLimit then
-    While (aOffset>0) and not D.EOF do
-      begin
-      D.Next;
-      Dec(aOffset);
-      end;
-  While not (D.EOF or LimitReached) do
+  if CurrentOnly then
+    StreamRecord(O,D,FieldList)
+  else
     begin
     begin
-    If StreamRecord(O,D,FieldList) then
+    if EmulateOffsetLimit then
+      While (aOffset>0) and not D.EOF do
+        begin
+        D.Next;
+        Dec(aOffset);
+        end;
+    While not (D.EOF or LimitReached) do
       begin
       begin
-      Dec(aLimit);
-      inc(Result);
+      If StreamRecord(O,D,FieldList) then
+        begin
+        Dec(aLimit);
+        inc(Result);
+        end;
+      D.Next;
       end;
       end;
-    D.Next;
     end;
     end;
   O.EndData;
   O.EndData;
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.GetSpecialDatasetForResource(aFieldList : TRestFieldPairArray) :  TDataset;
+function TSQLDBRestDBHandler.GetSpecialDatasetForResource(
+  aFieldList: TRestFieldPairArray): TDataset;
 
 
 
 
 Var
 Var
@@ -612,7 +628,7 @@ begin
     FExternalDataset.FreeNotification(Self);
     FExternalDataset.FreeNotification(Self);
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.SpecialResource : Boolean;
+function TSQLDBRestDBHandler.SpecialResource: Boolean;
 
 
 begin
 begin
   Result:=(ExternalDataset<>Nil) or Assigned(FResource.OnGetDataset);
   Result:=(ExternalDataset<>Nil) or Assigned(FResource.OnGetDataset);
@@ -689,12 +705,76 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function TSQLDBRestDBHandler.GetGeneratorValue(Const aGeneratorName : String) : Int64;
+function TSQLDBRestDBHandler.GetGeneratorValue(const aGeneratorName: String
+  ): Int64;
 
 
 begin
 begin
   Result:=IO.Connection.GetNextValue(aGeneratorName,1);
   Result:=IO.Connection.GetNextValue(aGeneratorName,1);
 end;
 end;
 
 
+procedure TSQLDBRestDBHandler.SetPostFields(aFields : TFields);
+
+Var
+  I : Integer;
+  FData : TField;
+  D : TJSONData;
+  RF : TSQLDBRestField;
+  V : UTF8string;
+
+begin
+  // Another approach would be to create params for all fields,
+  // call setPostParams, and copy field data from all set params
+  // That would allow the use of checkparams...
+  For I:=0 to aFields.Count-1 do
+    try
+      D:=Nil;
+      FData:=aFields[i];
+      RF:=FResource.Fields.FindByFieldName(FData.FieldName);
+      if (RF<>Nil) then
+        begin
+        if (RF.GeneratorName<>'')  then // Only when doing POST
+          D:=TJSONInt64Number.Create(GetGeneratorValue(RF.GeneratorName))
+        else
+          D:=IO.RESTInput.GetContentField(RF.PublicName);
+        end
+      else if IO.GetVariable(FData.Name,V,[vsContent,vsQuery])<>vsNone then
+        D:=TJSONString.Create(V);
+      if (D<>Nil) then
+        SetFieldFromData(FData,RF,D); // Use new value, if any
+    finally
+      D.Free;
+    end;
+end;
+
+procedure TSQLDBRestDBHandler.SetFieldFromData(DataField: TField; ResField: TSQLDBRestField; D: TJSONData);
+
+begin
+  if not Assigned(D) then
+    DataField.Clear
+  else if Assigned(ResField) then
+    Case ResField.FieldType of
+      rftInteger : DataField.AsInteger:=D.AsInteger;
+      rftLargeInt : DataField.AsLargeInt:=D.AsInt64;
+      rftFloat : DataField.AsFloat:=D.AsFloat;
+      rftDate : DataField.AsDateTime:=ScanDateTime(GetString(rpDateFormat),D.AsString);
+      rftTime : DataField.AsDateTime:=ScanDateTime(GetString(rpTimeFormat),D.AsString);
+      rftDateTime : DataField.AsDateTime:=ScanDateTime(GetString(rpDateTimeFormat),D.AsString);
+      rftString : DataField.AsString:=D.AsString;
+      rftBoolean : DataField.AsBoolean:=D.AsBoolean;
+      rftBlob :
+{$IFNDEF VER3_0}
+         DataField.AsString:=BytesOf(DecodeStringBase64(D.AsString));
+{$ELSE}
+         DataField.AsString:=DecodeStringBase64(D.AsString);
+{$ENDIF}
+    else
+      DataField.AsString:=D.AsString;
+    end
+  else
+    DataField.AsString:=D.AsString;
+end;
+
+
 procedure TSQLDBRestDBHandler.SetPostParams(aParams : TParams; Old : TFields = Nil);
 procedure TSQLDBRestDBHandler.SetPostParams(aParams : TParams; Old : TFields = Nil);
 
 
 Var
 Var
@@ -712,7 +792,7 @@ begin
       FOld:=Nil;
       FOld:=Nil;
       P:=aParams[i];
       P:=aParams[i];
       F:=FResource.Fields.FindByFieldName(P.Name);
       F:=FResource.Fields.FindByFieldName(P.Name);
-      If Assigned(Fold) then
+      If Assigned(Old) then
         Fold:=Old.FindField(P.Name);
         Fold:=Old.FindField(P.Name);
       if (F<>Nil) then
       if (F<>Nil) then
         begin
         begin
@@ -744,19 +824,33 @@ Var
   SQL : UTF8String;
   SQL : UTF8String;
 
 
 begin
 begin
-  SQL:=FResource.GetResolvedSQl(skInsert,'','','');
-  S:=TSQLStatement.Create(Self);
-  try
-    S.Database:=IO.Connection;
-    S.Transaction:=IO.Transaction;
-    S.SQL.Text:=SQL;
-    SetPostParams(S.Params);
-    S.Execute;
-    PostParams.Assign(S.Params);
-    S.Transaction.Commit;
-  Finally
-    S.Free;
-  end;
+  if Assigned(ExternalDataset) then
+    begin
+    ExternalDataset.Append;
+    SetPostFields(ExternalDataset.Fields);
+    try
+      ExternalDataset.Post;
+    except
+      ExternalDataset.Cancel;
+      Raise;
+    end
+    end
+  else
+    begin
+    SQL:=FResource.GetResolvedSQl(skInsert,'','','');
+    S:=TSQLStatement.Create(Self);
+    try
+      S.Database:=IO.Connection;
+      S.Transaction:=IO.Transaction;
+      S.SQL.Text:=SQL;
+      SetPostParams(S.Params);
+      S.Execute;
+      PostParams.Assign(S.Params);
+      S.Transaction.Commit;
+    Finally
+      S.Free;
+    end;
+    end;
 end;
 end;
 
 
 procedure TSQLDBRestDBHandler.DoHandlePost;
 procedure TSQLDBRestDBHandler.DoHandlePost;
@@ -789,20 +883,68 @@ Var
   SQl : String;
   SQl : String;
 
 
 begin
 begin
-  SQL:=FResource.GetResolvedSQl(skUpdate,'','','');
-  S:=TSQLStatement.Create(Self);
-  try
-    S.Database:=IO.Connection;
-    S.Transaction:=IO.Transaction;
-    S.SQL.Text:=SQL;
-    SetPostParams(S.Params,OldData.Fields);
-    // Give user a chance to look at it.
-    FResource.CheckParams(io.RestContext,roPut,S.Params);
-    S.Execute;
-    S.Transaction.Commit;
-  finally
-    S.Free;
-  end;
+  if (OldData=ExternalDataset) then
+    begin
+    ExternalDataset.Edit;
+    try
+      SetPostFields(ExternalDataset.Fields);
+      ExternalDataset.Post;
+    except
+      ExternalDataset.Cancel;
+      Raise;
+    end
+    end
+  else
+    begin
+    SQL:=FResource.GetResolvedSQl(skUpdate,'','','');
+    S:=TSQLStatement.Create(Self);
+    try
+      S.Database:=IO.Connection;
+      S.Transaction:=IO.Transaction;
+      S.SQL.Text:=SQL;
+      SetPostParams(S.Params,OldData.Fields);
+      // Give user a chance to look at it.
+      FResource.CheckParams(io.RestContext,roPut,S.Params);
+      S.Execute;
+      S.Transaction.Commit;
+    finally
+      S.Free;
+    end;
+    end;
+end;
+
+Function TSQLDBRestDBHandler.FindExistingRecord(D : TDataset) : Boolean;
+
+Var
+  KeyFields : String;
+  FieldList : TRestFilterPairArray;
+  FP : TRestFilterPair;
+  V : Variant;
+  I : Integer;
+
+begin
+  D.Open;
+  if D<>ExternalDataset then
+    Result:=Not (D.BOF and D.EOF)
+  else
+    begin
+    GetIDWhere(FieldList);
+    V:=VarArrayCreate([0,Length(FieldList)-1],varVariant);
+    KeyFields:='';
+    I:=0;
+    For FP in FieldList do
+      begin
+      if KeyFields<>'' then
+        KeyFields:=KeyFields+';';
+      KeyFields:=KeyFields+FP.Field.FieldName;
+      if Assigned(FP.ValueParam) then
+        V[i]:=FP.ValueParam.Value
+      else
+        V[i]:=FP.Value;
+      Inc(i);
+      end;
+    Result:=D.Locate(KeyFields,V,[loCaseInsensitive]);
+    end;
 end;
 end;
 
 
 procedure TSQLDBRestDBHandler.DoHandlePut;
 procedure TSQLDBRestDBHandler.DoHandlePut;
@@ -819,18 +961,20 @@ begin
   FieldList:=BuildFieldList(True);
   FieldList:=BuildFieldList(True);
   D:=GetDatasetForResource(FieldList,True);
   D:=GetDatasetForResource(FieldList,True);
   try
   try
-    D.Open;
-    if (D.BOF and D.EOF) then
+    if not FindExistingRecord(D) then
       begin
       begin
       DoNotFound;
       DoNotFound;
       exit;
       exit;
       end;
       end;
     UpdateExistingRecord(D);
     UpdateExistingRecord(D);
     // Now build response
     // Now build response
-    FreeAndNil(D);
-    FieldList:=BuildFieldList(False);
-    D:=GetDatasetForResource(FieldList,True);
-    D.Open;
+    if D<>ExternalDataset then
+      begin;
+      FreeAndNil(D);
+      D:=GetDatasetForResource(FieldList,True);
+      FieldList:=BuildFieldList(False);
+      D.Open;
+      end;
     IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
     IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
     StreamDataset(IO.RESTOutput,D,FieldList);
     StreamDataset(IO.RESTOutput,D,FieldList);
   finally
   finally
@@ -863,17 +1007,27 @@ Var
   FilteredFields : TRestFilterPairArray;
   FilteredFields : TRestFilterPairArray;
 
 
 begin
 begin
-  aWhere:=GetIDWhere(FilteredFields);
-  SQL:=FResource.GetResolvedSQl(skDelete,aWhere,'');
-  Q:=CreateQuery(SQL);
-  try
-    FillParams(roDelete,Q,FilteredFields);
-    Q.ExecSQL;
-    if Q.RowsAffected<>1 then
+  if Assigned(ExternalDataset) then
+    begin
+    If FindExistingRecord(ExternalDataset) then
+      ExternalDataset.Delete
+    else
       DoNotFound;
       DoNotFound;
-  finally
-    Q.Free;
-  end;
+    end
+  else
+    begin
+    aWhere:=GetIDWhere(FilteredFields);
+    SQL:=FResource.GetResolvedSQl(skDelete,aWhere,'');
+    Q:=CreateQuery(SQL);
+    try
+      FillParams(roDelete,Q,FilteredFields);
+      Q.ExecSQL;
+      if Q.RowsAffected<>1 then
+        DoNotFound;
+    finally
+      Q.Free;
+    end;
+    end;
 end;
 end;
 
 
 end.
 end.

+ 5 - 2
packages/fcl-web/src/restbridge/sqldbrestio.pp

@@ -73,7 +73,8 @@ Type
                          rpOutputFormat,
                          rpOutputFormat,
                          rpCustomViewResourceName,
                          rpCustomViewResourceName,
                          rpCustomViewSQLParam,
                          rpCustomViewSQLParam,
-                         rpXMLDocumentRoot
+                         rpXMLDocumentRoot,
+                         rpConnectionResourceName
                          );
                          );
   TRestStringProperties = Set of TRestStringProperty;
   TRestStringProperties = Set of TRestStringProperty;
 
 
@@ -131,6 +132,7 @@ Type
     Property CustomViewResourceName : UTF8string Index ord(rpCustomViewResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property CustomViewResourceName : UTF8string Index ord(rpCustomViewResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property CustomViewSQLParam : UTF8string Index ord(rpCustomViewSQLParam) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
     Property XMLDocumentRoot : UTF8string Index ord(rpXMLDocumentRoot) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
+    Property ConnectionResourceName : UTF8string Index ord(rpConnectionResourceName) Read GetRestPropName Write SetRestPropName Stored IsRestStringStored;
   end;
   end;
 
 
   TRestStatus = (rsError,                   // Internal logic/unexpected error (500)
   TRestStatus = (rsError,                   // Internal logic/unexpected error (500)
@@ -430,7 +432,8 @@ Const
     'fmt',             { rpOutputFormat }
     'fmt',             { rpOutputFormat }
     'customview',      { rpCustomViewResourceName }
     'customview',      { rpCustomViewResourceName }
     'sql',             { rpCustomViewSQLParam }
     'sql',             { rpCustomViewSQLParam }
-    'datapacket'       { rpXMLDocumentRoot}
+    'datapacket',      { rpXMLDocumentRoot}
+    '_connection'      { rpConnectionResourceName }
   );
   );
   DefaultStatuses : Array[TRestStatus] of Word = (
   DefaultStatuses : Array[TRestStatus] of Word = (
     500, { rsError }
     500, { rsError }

+ 13 - 8
packages/fcl-web/src/restbridge/sqldbrestschema.pp

@@ -197,7 +197,7 @@ Type
     Function AllowResource(aContext : TBaseRestContext) : Boolean;
     Function AllowResource(aContext : TBaseRestContext) : Boolean;
     Function GetAllowedOperations(aContext : TBaseRestContext) : TRestOperations;
     Function GetAllowedOperations(aContext : TBaseRestContext) : TRestOperations;
     Function GetHTTPAllow : String; virtual;
     Function GetHTTPAllow : String; virtual;
-    function GetFieldList(aListKind: TFieldListKind): UTF8String;
+    function GetFieldList(aListKind: TFieldListKind; ASep : String = ''): UTF8String;
     function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray;
     function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray;
     Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
     Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
     Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
     Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
@@ -1064,7 +1064,7 @@ begin
       AddR(Methods[O]);
       AddR(Methods[O]);
 end;
 end;
 
 
-function TSQLDBRestResource.GetFieldList(aListKind : TFieldListKind) : UTF8String;
+function TSQLDBRestResource.GetFieldList(aListKind : TFieldListKind; ASep : String = '') : UTF8String;
 
 
 Const
 Const
   SepComma = ', ';
   SepComma = ', ';
@@ -1072,7 +1072,7 @@ Const
   SepSpace = ' ';
   SepSpace = ' ';
 
 
 Const
 Const
-  Seps : Array[TFieldListKind] of string = (sepComma,sepComma,sepComma,sepComma,sepAnd,sepSpace,sepComma);
+  DefaultSeps : Array[TFieldListKind] of string = (sepComma,sepComma,sepComma,sepComma,sepAnd,sepSpace,sepComma);
 
 
 Const
 Const
   Wheres = [flWhereKey];
   Wheres = [flWhereKey];
@@ -1080,15 +1080,20 @@ Const
   UseEqual = Wheres+[flUpdate];
   UseEqual = Wheres+[flUpdate];
 
 
 Var
 Var
-  Term,Res,Prefix : UTF8String;
+  Sep,Term,Res,Prefix : UTF8String;
   I : Integer;
   I : Integer;
   F : TSQLDBRestField;
   F : TSQLDBRestField;
 
 
 begin
 begin
   Prefix:='';
   Prefix:='';
+  Sep:=aSep;
+  if Sep='' then
+    begin
+    Sep:=DefaultSeps[aListKind];
+    If aListKind in Colons then
+      Prefix:=':';
+    end;
   Res:='';
   Res:='';
-  If aListKind in Colons then
-    Prefix:=':';
   For I:=0 to Fields.Count-1 do
   For I:=0 to Fields.Count-1 do
     begin
     begin
     Term:='';
     Term:='';
@@ -1096,7 +1101,7 @@ begin
     if F.UseInFieldList(aListKind) then
     if F.UseInFieldList(aListKind) then
       begin
       begin
       Term:=Prefix+F.FieldName;
       Term:=Prefix+F.FieldName;
-      if aListKind in UseEqual then
+      if (aSep='') and (aListKind in UseEqual) then
         begin
         begin
         Term := F.FieldName+' = '+Term;
         Term := F.FieldName+' = '+Term;
         if (aListKind in Wheres) then
         if (aListKind in Wheres) then
@@ -1106,7 +1111,7 @@ begin
     if (Term<>'') then
     if (Term<>'') then
       begin
       begin
       If (Res<>'') then
       If (Res<>'') then
-        Res:=Res+Seps[aListKind];
+        Res:=Res+Sep;
       Res:=Res+Term;
       Res:=Res+Term;
       end;
       end;
     end;
     end;