diff --git a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp index 00d4eba03e..8d05077cc7 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp @@ -22,7 +22,7 @@ uses Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth; Type - TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS); + TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS,rdoAccessCheckNeedsDB); TRestDispatcherOptions = set of TRestDispatcherOption; Const @@ -227,6 +227,10 @@ Type function ExtractRestOperation(aRequest: TRequest;AccessControl : Boolean = false): TRestoperation; virtual; function FindRestResource(aResource: UTF8String): TSQLDBRestResource; virtual; function AllowRestResource(aIO : TRestIO): Boolean; virtual; + function AllowRestOperation(aIO: TRestIO): Boolean; virtual; + // Called twice: once before connection is established, once after. + // checks rdoAccessCheckNeedsDB and availability of connection + function CheckResourceAccess(IO: TRestIO): Boolean; function ExtractRestResourceName(IO: TRestIO): UTF8String; virtual; // Override if you want to create non-sqldb based resources function CreateSpecialResourceDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual; @@ -634,10 +638,10 @@ begin Result:=IO.Request.QueryFields.Values[Strings.ResourceParam]; end; -function TSQLDBRestDispatcher.AllowRestResource( aIO: TRestIO): Boolean; +function TSQLDBRestDispatcher.AllowRestResource(aIO: TRestIO): Boolean; begin - Result:=True; + Result:=aIO.Resource.AllowResource(aIO.RestContext); if Assigned(FOnAllowResource) then FOnAllowResource(Self,aIO.Request,aIO.ResourceName,Result); end; @@ -1188,6 +1192,8 @@ begin Try if not AuthenticateRequest(IO,True) then exit; + if Not CheckResourceAccess(IO) then + exit; DoHandleEvent(True,IO); H:=CreateDBHandler(IO); if IsSpecialResource(IO.Resource) then @@ -1265,6 +1271,33 @@ begin Result:=TSQLDBRestSchemaList.Create(TSQLDBRestSchemaRef); end; +function TSQLDBRestDispatcher.AllowRestOperation(aIO: TRestIO): Boolean; + +begin + Result:=(aIO.Operation in aIO.Resource.GetAllowedOperations(aIO.RestContext)); +end; + +Function TSQLDBRestDispatcher.CheckResourceAccess(IO : TRestIO) : Boolean; + +Var + NeedDB : Boolean; + +begin + NeedDB:=(rdoAccessCheckNeedsDB in DispatchOptions); + Result:=NeedDB<>Assigned(IO.Connection); + if Result then + exit; + Result:=AllowRestResource(IO); + if not Result then + CreateErrorContent(IO,403,'Forbidden') + else + begin + Result:=AllowRestOperation(IO); + if not Result then + CreateErrorContent(IO,405,'Method not allowed') + end; +end; + procedure TSQLDBRestDispatcher.DoHandleRequest(IO : TRestIO); var @@ -1290,8 +1323,6 @@ begin Resource:=FindRestResource(ResourceName); if Resource=Nil then CreateErrorContent(IO,404,'Invalid resource') - else if Not (Operation in Resource.AllowedOperations) then - CreateErrorContent(IO,405,'Method not allowed') else begin IO.SetResource(Resource); @@ -1303,9 +1334,7 @@ begin else CreateErrorContent(IO,500,Format(SErrNoconnection,[GetConnectionName(IO)])); end - else if not AllowRestResource(IO) then - CreateErrorContent(IO,403,'Forbidden') - else + else if CheckResourceAccess(IO) then if Operation=roOptions then HandleCORSRequest(Connection,IO) else diff --git a/packages/fcl-web/src/restbridge/sqldbrestdata.pp b/packages/fcl-web/src/restbridge/sqldbrestdata.pp index 45e5790ef0..e4b8c2cc62 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestdata.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestdata.pp @@ -532,7 +532,7 @@ Var i : Integer; begin - Result:=IO.Resource.AllowRecord(D); + Result:=IO.Resource.AllowRecord(IO.RestContext,D); if not Result then exit; O.StartRow; @@ -598,7 +598,7 @@ begin if (Result=Nil) then begin GetLimitOffset(aLimit,aOffset); - Result:=FResource.GetDataset(aFieldList,GetOrderByFieldArray,aLimit,aOffset); + Result:=FResource.GetDataset(IO.RestContext,aFieldList,GetOrderByFieldArray,aLimit,aOffset); end; end; @@ -731,7 +731,7 @@ begin D.Free; end; // Give user a chance to look at it. - FResource.CheckParams(roPost,aParams); + FResource.CheckParams(io.RestContext,roPost,aParams); // Save so it can be used in GetWHereID for return FPostParams:=TParams.Create(TParam); FPostParams.Assign(aParams); @@ -797,7 +797,7 @@ begin S.SQL.Text:=SQL; SetPostParams(S.Params,OldData.Fields); // Give user a chance to look at it. - FResource.CheckParams(roPut,S.Params); + FResource.CheckParams(io.RestContext,roPut,S.Params); S.Execute; S.Transaction.Commit; finally diff --git a/packages/fcl-web/src/restbridge/sqldbrestio.pp b/packages/fcl-web/src/restbridge/sqldbrestio.pp index 4ddb320c84..71c3eaacb8 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestio.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestio.pp @@ -21,10 +21,8 @@ interface uses Classes, SysUtils, fpjson, sqldb, db, httpdefs, sqldbrestschema; -Type - TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader); - TVariableSources = Set of TVariableSource; +Type TRestOutputOption = (ooMetadata,ooSparse,ooHumanReadable); TRestOutputOptions = Set of TRestOutputOption; @@ -37,6 +35,8 @@ Const Type + TRestIO = Class; + TRestStringProperty = (rpDateFormat, rpDateTimeFormat, rpTimeFormat, @@ -192,6 +192,17 @@ Type end; TRestOutputStreamerClass = class of TRestOutputStreamer; + { TRestContext } + + TRestContext = Class(TBaseRestContext) + Private + FIO : TRestIO; + Protected + property IO : TRestIO Read FIO; + Public + Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; override; + end; + { TRestIO } TRestIO = Class @@ -205,11 +216,13 @@ Type FResource: TSQLDBRestResource; FResourceName: UTF8String; FResponse: TResponse; + FRestContext: TRestContext; FRestStrings: TRestStringsConfig; FSchema: UTF8String; FTrans: TSQLTransaction; FContentStream : TStream; - FUserID: String; + function GetUserID: String; + procedure SetUserID(AValue: String); Protected Public Constructor Create(aRequest : TRequest; aResponse : TResponse); virtual; @@ -229,6 +242,7 @@ Type function GetRequestOutputOptions(aDefault: TRestOutputOptions): TRestOutputOptions; function GetLimitOffset(aEnforceLimit: Int64; out aLimit, aOffset: Int64): boolean; // Create error response in output + function CreateRestContext: TRestContext; virtual; Procedure CreateErrorResponse; Property Operation : TRestOperation Read FOperation; // Not owned by TRestIO @@ -242,11 +256,12 @@ Type Property RESTInput : TRestInputStreamer read FInput; Property RESTOutput : TRestOutputStreamer read FOutput; Property RequestContentStream : TStream Read FContentStream; + Property RestContext : TRestContext Read FRestContext; // For informative purposes Property ResourceName : UTF8String Read FResourceName; Property Schema : UTF8String Read FSchema; Property ConnectionName : UTF8String Read FCOnnection; - Property UserID : String Read FUserID Write FUserID; + Property UserID : String Read GetUserID Write SetUserID; end; TRestIOClass = Class of TRestIO; @@ -344,6 +359,13 @@ Const 'datapacket' { rpXMLDocumentRoot} ); +{ TRestContext } + +function TRestContext.GetVariable(const aName: UTF8String; aSources : TVariableSources; out aValue: UTF8String): Boolean; +begin + Result:=FIO.GetVariable(aName,aValue,aSources)<>vsNone; +end; + { TStreamerDefList } function TStreamerDefList.GetD(aIndex : integer): TStreamerDef; @@ -713,15 +735,29 @@ begin GetVariable(aName,aVal); end; +procedure TRestIO.SetUserID(AValue: String); +begin + if (UserID=AValue) then Exit; + FRestContext.UserID:=AValue; +end; + +function TRestIO.GetUserID: String; +begin + Result:=FRestContext.UserID; +end; + constructor TRestIO.Create(aRequest: TRequest; aResponse: TResponse); begin FRequest:=aRequest; FResponse:=aResponse; FContentStream:=TStringStream.Create(aRequest.Content); + FRestContext:=CreateRestContext; + FRestContext.FIO:=Self; end; destructor TRestIO.Destroy; begin + FreeAndNil(FRestContext); if Assigned(FInput) then Finput.FOnGetVar:=Nil; if Assigned(Foutput) then @@ -732,6 +768,12 @@ begin inherited Destroy; end; +function TRestIO.CreateRestContext : TRestContext; + +begin + Result:=TRestContext.Create; +end; + function TRestIO.GetVariable(const aName: UTF8String; out aVal: UTF8String; AllowedSources: TVAriableSources): TVariableSource; @@ -780,7 +822,8 @@ begin Result:=GetVariable(aName+FRestStrings.GetRestString(FilterStrings[aFilter]),aValue,[vsQuery]); end; -Class function TRestIO.StrToNullBoolean(S: String; Strict: Boolean): TNullBoolean; +class function TRestIO.StrToNullBoolean(S: String; Strict: Boolean + ): TNullBoolean; begin result:=nbNone; @@ -810,7 +853,8 @@ begin Result:=StrToNullBoolean(S,aStrict); end; -Function TRestIO.GetRequestOutputOptions(aDefault : TRestOutputOptions) : TRestOutputOptions; +function TRestIO.GetRequestOutputOptions(aDefault: TRestOutputOptions + ): TRestOutputOptions; Procedure CheckParam(aName : String; aOption: TRestOutputOption); begin diff --git a/packages/fcl-web/src/restbridge/sqldbrestschema.pp b/packages/fcl-web/src/restbridge/sqldbrestschema.pp index e7fe294ddd..c02f7dac0a 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestschema.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestschema.pp @@ -22,7 +22,6 @@ uses Classes, SysUtils, db, sqldb, fpjson; Type - TRestFieldType = (rftUnknown,rftInteger,rftLargeInt,rftFloat,rftDate,rftTime,rftDateTime,rftString,rftBoolean,rftBlob); TRestFieldTypes = set of TRestFieldType; @@ -41,6 +40,8 @@ Type TFieldListKind = (flSelect,flInsert,flInsertParams,flUpdate,flWhereKey,flFilter,flOrderby); TFieldListKinds = set of TFieldListKind; + TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader); + TVariableSources = Set of TVariableSource; Const AllRestOperations = [Succ(Low(TRestOperation))..High(TRestOperation)]; @@ -51,6 +52,22 @@ Const Type + { TBaseRestContext } + + TBaseRestContext = Class(TObject) + private + FData: TObject; + FUserID: UTF8String; + Public + // Call this to get a HTTP Query variable, header,... + Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; virtual; abstract; + // This will be set when calling. + Property UserID : UTF8String Read FUserID Write FUserID; + // You can attach data to this if you want to. It will be kept for the duration of the request. + // You are responsible for freeing this data, though. + Property Data : TObject Read FData Write FData; + end; + { ESQLDBRest } ESQLDBRest = Class(Exception) @@ -68,7 +85,8 @@ Type end; TSQLDBRestSchema = Class; - + TSQLDBRestCustomBusinessProcessor = Class; + TSQLDBRestBusinessProcessor = Class; { TSQLDBRestField } @@ -131,21 +149,26 @@ Type TSQLDBRestFieldListClass = Class of TSQLDBRestFieldList; { TSQLDBRestResource } - TSQLDBRestGetDatasetEvent = Procedure (aSender : TObject; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64; Var aDataset : TDataset) of object; - TSQLDBRestCheckParamsEvent = Procedure (aSender : TObject; aOperation : TRestOperation; Params : TParams) of object; - TSQLDBRestAllowRecordEvent = Procedure (aSender : TObject; aDataSet : TDataset; var allowRecord : Boolean) of object; + TSQLDBRestGetDatasetEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64; Var aDataset : TDataset) of object; + TSQLDBRestCheckParamsEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aOperation : TRestOperation; Params : TParams) of object; + TSQLDBRestAllowRecordEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aDataSet : TDataset; var allowRecord : Boolean) of object; + TSQLDBRestAllowResourceEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var allowResource : Boolean) of object; + TSQLDBRestAllowedOperationsEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var aOperations : TRestOperations) of object; TProcessIdentifier = Function (const S: UTF8String): UTF8String of object; TSQLDBRestResource = class(TCollectionItem) private + FBusinessProcessor: TSQLDBRestCustomBusinessProcessor; FAllowedOperations: TRestOperations; FConnectionName: UTF8String; FEnabled: Boolean; FFields: TSQLDBRestFieldList; FInMetadata: Boolean; + FOnAllowedOperations: TSQLDBRestAllowedOperationsEvent; FOnAllowRecord: TSQLDBRestAllowRecordEvent; FOnCheckParams: TSQLDBRestCheckParamsEvent; FOnGetDataset: TSQLDBRestGetDatasetEvent; + FOnResourceAllowed: TSQLDBRestAllowResourceEvent; FResourceName: UTF8String; FTableName: UTF8String; FSQL : Array[TSQLKind] of TStrings; @@ -165,18 +188,21 @@ Type Public Constructor Create(ACollection: TCollection); override; Destructor Destroy; override; - Procedure CheckParams(aOperation : TRestoperation; P : TParams); - Function GetDataset(aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; + Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); + Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; Function GetSchema : TSQLDBRestSchema; function GenerateDefaultSQL(aKind: TSQLKind): UTF8String; virtual; Procedure Assign(Source: TPersistent); override; - Function AllowRecord(aDataset : TDataset) : Boolean; + Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean; + Function AllowResource(aContext : TBaseRestContext) : Boolean; + Function GetAllowedOperations(aContext : TBaseRestContext) : TRestOperations; Function GetHTTPAllow : String; virtual; function GetFieldList(aListKind: TFieldListKind): UTF8String; function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray; Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String; Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions); Property SQL [aKind : TSQLKind] : TStrings Read GetSQLTyped; + Property BusinessProcessor : TSQLDBRestCustomBusinessProcessor Read FBusinessProcessor; Published Property Fields : TSQLDBRestFieldList Read FFields Write SetFields; Property Enabled : Boolean Read FEnabled Write FEnabled default true; @@ -189,6 +215,8 @@ Type Property SQLInsert : TStrings Index 1 Read GetSQL Write SetSQL; Property SQLUpdate : TStrings Index 2 Read GetSQL Write SetSQL; Property SQLDelete : TStrings Index 3 Read GetSQL Write SetSQL; + Property OnResourceAllowed : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed; + Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations; Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset; Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams; Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord; @@ -222,14 +250,21 @@ Type private FConnectionName: UTF8String; FResources: TSQLDBRestResourceList; + FProcessors : TFPList; procedure SetResources(AValue: TSQLDBRestResourceList); Protected function CreateResourceList: TSQLDBRestResourceList; virtual; function GetPrimaryIndexFields(Q: TSQLQuery): TStringArray; virtual; function ProcessIdentifier(const S: UTF8String): UTF8String; virtual; + Function AttachProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor) : Boolean; Virtual; + Function DetachProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor) : Boolean; Virtual; + Procedure AttachAllProcessors; virtual; + Procedure DetachAllProcessors; virtual; Public Constructor Create(AOwner: TComponent); override; Destructor Destroy; override; + Procedure RemoveBusinessProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor); + Procedure AddBusinessProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor); Procedure SaveToFile(Const aFileName : UTF8String); Procedure SaveToStream(Const aStream : TStream); function AsJSON(const aPropName: UTF8String=''): TJSONData; @@ -247,6 +282,54 @@ Type TCustomViewResource = Class(TSQLDBRestResource) end; + { TSQLDBRestCustomBusinessProcessor } + + TSQLDBRestCustomBusinessProcessor = Class(TComponent) + private + FResource: TSQLDBRestResource; + FResourceName: UTF8String; + procedure SetResourceName(AValue: UTF8String); + Protected + Function GetSchema : TSQLDBRestSchema; virtual; + Function GetAllowedOperations(aContext : TBaseRestContext; aDefault : TRestOperations) : TRestOperations; virtual; abstract; + Function AllowResource(aContext : TBaseRestContext) : Boolean; virtual; abstract; + Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); virtual; abstract; + Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; virtual;abstract; + Function AllowRecord(aContext : TBaseRestContext;aDataset : TDataset) : Boolean; virtual; abstract; + Public + Property Resource : TSQLDBRestResource Read FResource; + Property ResourceName : UTF8String Read FResourceName Write SetResourceName; + end; + + { TSQLDBRestBusinessProcessor } + TOnGetHTTPAllow = Procedure(Sender : TObject; Var aHTTPAllow) of object; + + TSQLDBRestBusinessProcessor = class(TSQLDBRestCustomBusinessProcessor) + private + FOnAllowedOperations: TSQLDBRestAllowedOperationsEvent; + FOnAllowRecord: TSQLDBRestAllowRecordEvent; + FOnCheckParams: TSQLDBRestCheckParamsEvent; + FOnGetDataset: TSQLDBRestGetDatasetEvent; + FOnResourceAllowed: TSQLDBRestAllowResourceEvent; + FSchema: TSQLDBRestSchema; + procedure SetSchema(AValue: TSQLDBRestSchema); + Protected + Function GetSchema : TSQLDBRestSchema; override; + Function AllowResource(aContext : TBaseRestContext) : Boolean; override; + Function GetAllowedOperations(aContext : TBaseRestContext; aDefault : TRestOperations) : TRestOperations; override; + Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); override; + Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; override; + Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean; override; + Published + Property Schema : TSQLDBRestSchema Read GetSchema Write SetSchema; + Property ResourceName; + Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset; + Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams; + Property OnAllowResource : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed; + Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations; + Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord; + end; + Const TypeNames : Array[TRestFieldType] of string = ('?','int','bigint','float','date','time','datetime','string','bool','blob'); @@ -254,6 +337,95 @@ implementation uses strutils, fpjsonrtti,dbconst, sqldbrestconst; +{ TSQLDBRestCustomBusinessProcessor } + +procedure TSQLDBRestCustomBusinessProcessor.SetResourceName(AValue: UTF8String); + +Var + S : TSQLDBRestSchema; + +begin + if FResourceName=AValue then Exit; + // Reregister, so the attachment happens to the correct resource + S:=GetSchema; + If (FResourceName<>'') and Assigned(S) then + S.RemoveBusinessProcessor(Self); + FResourceName:=AValue; + S:=GetSchema; + If (FResourceName<>'') and Assigned(S) then + S.AddBusinessProcessor(Self); +end; + +function TSQLDBRestCustomBusinessProcessor.GetSchema: TSQLDBRestSchema; + +begin + Result:=Nil; +end; + +{ TSQLDBRestBusinessProcessor } + +procedure TSQLDBRestBusinessProcessor.SetSchema(AValue: TSQLDBRestSchema); +begin + if FSchema=AValue then Exit; + if Assigned(FSchema) and (ResourceName<>'') then + begin + FSchema.RemoveBusinessProcessor(Self); + FSchema.RemoveFreeNotification(Self); + end; + FSchema:=AValue; + if Assigned(FSchema) and (ResourceName<>'') then + begin + FSchema.AddBusinessProcessor(Self); + FSchema.FreeNotification(Self); + end +end; + +function TSQLDBRestBusinessProcessor.GetSchema: TSQLDBRestSchema; +begin + Result:=FSchema; +end; + +function TSQLDBRestBusinessProcessor.AllowResource(aContext: TBaseRestContext + ): Boolean; +begin + Result:=True; + if Assigned(FOnResourceAllowed) then + FOnResourceAllowed(Self,aContext,Result); + +end; + +function TSQLDBRestBusinessProcessor.GetAllowedOperations( + aContext: TBaseRestContext; aDefault: TRestOperations): TRestOperations; +begin + Result:=aDefault; + if Assigned(FOnAllowedOperations) then + FOnAllowedOperations(Self,aContext,Result); +end; + +procedure TSQLDBRestBusinessProcessor.CheckParams(aContext: TBaseRestContext; + aOperation: TRestoperation; P: TParams); +begin + if Assigned(FOnCheckParams) then + FOnCheckParams(Self,aContext,aOperation,P); +end; + +function TSQLDBRestBusinessProcessor.GetDataset(aContext : TBaseRestContext; + aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit, + aOffset: Int64): TDataset; +begin + Result:=nil; + if Assigned(FOnGetDataset) then + FOnGetDataset(Self,aContext,aFieldList,aOrderBy,aLimit,aOffset,Result); +end; + +function TSQLDBRestBusinessProcessor.AllowRecord(aContext : TBaseRestContext; aDataset: TDataset): Boolean; +begin + Result:=True; + if Assigned(FOnAllowRecord) then + FOnAllowRecord(Self,acontext,aDataset,Result); +end; + + { ESQLDBRest } @@ -285,9 +457,10 @@ constructor TSQLDBRestSchema.Create(AOwner: TComponent); begin inherited Create(AOwner); FResources:=CreateResourceList; + FProcessors:=TFPList.Create; end; -Function TSQLDBRestSchema.CreateResourceList : TSQLDBRestResourceList; +function TSQLDBRestSchema.CreateResourceList: TSQLDBRestResourceList; begin Result:=TSQLDBRestResourceList.Create(Self,TSQLDBRestResource); @@ -295,10 +468,26 @@ end; destructor TSQLDBRestSchema.Destroy; begin + FreeAndNil(FProcessors); FreeAndNil(FResources); inherited Destroy; end; +procedure TSQLDBRestSchema.RemoveBusinessProcessor( + aProcessor: TSQLDBRestCustomBusinessProcessor); + +begin + DetachProcessor(aProcessor); + FProcessors.Remove(aProcessor); +end; + +procedure TSQLDBRestSchema.AddBusinessProcessor( + aProcessor: TSQLDBRestCustomBusinessProcessor); +begin + FProcessors.Remove(aProcessor); + AttachProcessor(aProcessor); +end; + procedure TSQLDBRestSchema.SaveToFile(const aFileName: UTF8String); Var F : TFileStream; @@ -371,16 +560,69 @@ begin J:=aData as TJSONObject; Resources.FromJSON(J,JSONResourcesRoot); ConnectionName:=J.Get(aPropName,''); + AttachAllProcessors; end; -Function TSQLDBRestSchema.ProcessIdentifier(Const S : UTF8String) : UTF8String; +function TSQLDBRestSchema.ProcessIdentifier(const S: UTF8String): UTF8String; begin Result:=S; end; +function TSQLDBRestSchema.AttachProcessor(aProcessor: TSQLDBRestCustomBusinessProcessor): Boolean; -Function TSQLDBRestSchema.GetPrimaryIndexFields(Q : TSQLQuery) : TStringArray; +Var + Res : TSQLDBRestResource; + +begin + if aProcessor.ResourceName='' then + exit; + Res:=FResources.FindResourceByName(aProcessor.ResourceName); + Result:=Assigned(Res); + if Result then + begin + Res.FBusinessProcessor:=aProcessor; + aProcessor.FResource:=Res; + end; +end; + +function TSQLDBRestSchema.DetachProcessor(aProcessor: TSQLDBRestCustomBusinessProcessor): Boolean; +Var + Res : TSQLDBRestResource; + +begin + if aProcessor.ResourceName='' then + exit; + Res:=FResources.FindResourceByName(aProcessor.ResourceName); + Result:=Assigned(Res); + if Result then + begin + Res.FBusinessProcessor:=Nil; + aProcessor.FResource:=Nil; + end; +end; + +procedure TSQLDBRestSchema.AttachAllProcessors; + +Var + I : integer; + +begin + For I:=0 to FProcessors.Count-1 do + AttachProcessor(TSQLDBRestCustomBusinessProcessor(FProcessors[i])); +end; + +procedure TSQLDBRestSchema.DetachAllProcessors; +Var + I : integer; + +begin + For I:=0 to FProcessors.Count-1 do + DetachProcessor(TSQLDBRestCustomBusinessProcessor(FProcessors[i])); +end; + + +function TSQLDBRestSchema.GetPrimaryIndexFields(Q: TSQLQuery): TStringArray; Var C,I : Integer; @@ -434,7 +676,8 @@ begin end; end; -procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection; aTables : Array of string; aMinFieldOpts : TRestFieldOptions = []); +procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection; + aTables: array of string; aMinFieldOpts: TRestFieldOptions); Var L : TStringList; @@ -676,6 +919,7 @@ begin Result:=FSQL[aKind]; end; + procedure TSQLDBRestResource.SetFields(AValue: TSQLDBRestFieldList); begin if FFields=AValue then Exit; @@ -713,23 +957,29 @@ Var K : TSQLKind; begin + If Assigned(FBusinessProcessor) then + FBusinessProcessor.FResource:=Nil; FreeAndNil(FFields); for K in TSQLKind do FreeAndNil(FSQL[K]); inherited Destroy; end; -procedure TSQLDBRestResource.CheckParams(aOperation: TRestoperation; P: TParams); +procedure TSQLDBRestResource.CheckParams(aContext : TBaseRestContext; aOperation: TRestoperation; P: TParams); begin if Assigned(FOnCheckParams) then - FOnCheckParams(Self,aOperation,P); + FOnCheckParams(Self,aContext,aOperation,P) + else if Assigned(FBusinessProcessor) then + FBusinessProcessor.CheckParams(aContext,aOperation,P) end; -function TSQLDBRestResource.GetDataset(aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit, aOffset: Int64): TDataset; +function TSQLDBRestResource.GetDataset(aContext : TBaseRestContext; aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit, aOffset: Int64): TDataset; begin Result:=Nil; If Assigned(FOnGetDataset) then - FOnGetDataset(Self,aFieldList,aOrderBy,aLimit,aOffset,Result); + FOnGetDataset(Self,aContext,aFieldList,aOrderBy,aLimit,aOffset,Result) + else if Assigned(FBusinessProcessor) then + Result:=FBusinessProcessor.GetDataset(aContext,aFieldList,aOrderBy,aLimit,aOffset); end; function TSQLDBRestResource.GetSchema: TSQLDBRestSchema; @@ -763,11 +1013,32 @@ begin inherited Assign(Source); end; -function TSQLDBRestResource.AllowRecord(aDataset: TDataset): Boolean; +function TSQLDBRestResource.AllowRecord(aContext : TBaseRestContext; aDataset: TDataset): Boolean; begin Result:=True; if Assigned(FOnAllowRecord) then - FOnAllowRecord(Self,aDataset,Result); + FOnAllowRecord(Self,aContext,aDataset,Result) + else if Assigned(FBusinessProcessor) then + Result:=FBusinessProcessor.AllowRecord(aContext,aDataset); +end; + +function TSQLDBRestResource.AllowResource(aContext : TBaseRestContext): Boolean; +begin + Result:=True; + If Assigned(FOnResourceAllowed) then + FOnResourceAllowed(Self,aContext,Result) + else If Assigned(FBusinessProcessor) then + Result:=FBusinessProcessor.AllowResource(aContext); +end; + +function TSQLDBRestResource.GetAllowedOperations(aContext: TBaseRestContext + ): TRestOperations; +begin + Result:=AllowedOperations; + if Assigned(FOnAllowedOperations) then + FOnAllowedOperations(Self,aContext,Result) + else if Assigned(FBusinessProcessor) then + Result:=FBusinessProcessor.GetAllowedOperations(aContext,Result); end; function TSQLDBRestResource.GetHTTPAllow: String;