diff --git a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp index c2a33e0205..bb209eec64 100644 --- a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp +++ b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp @@ -61,6 +61,7 @@ type FDatabaseInfo : TDatabaseInfo; FDialect : integer; FBlobSegmentSize : word; //required for backward compatibilty; not used + FUseConnectionCharSetIfNone: Boolean; procedure ConnectFB; @@ -132,6 +133,7 @@ type property Params; property OnLogin; Property Port stored false; + Property UseConnectionCharSetIfNone : Boolean Read FUseConnectionCharSetIfNone Write FUseConnectionCharSetIfNone; end; { TIBConnectionDef } @@ -988,7 +990,8 @@ begin TransType, TransLen, TransPrec); // [var]char or blob column character set NONE or OCTETS overrides connection charset - if ((TransType in [ftString, ftFixedChar]) and (PSQLVar^.sqlsubtype and $FF in [CS_NONE,CS_BINARY])) or + if (((TransType in [ftString, ftFixedChar]) and (PSQLVar^.sqlsubtype and $FF in [CS_NONE,CS_BINARY])) and not UseConnectionCharSetIfNone) + or ((TransType = ftMemo) and (PSQLVar^.relname_length>0) and (PSQLVar^.sqlname_length>0) and (GetBlobCharset(@PSQLVar^.relname,@PSQLVar^.sqlname) in [CS_NONE,CS_BINARY])) then FieldDefs.Add(PSQLVar^.AliasName, TransType, TransLen, TransPrec, (PSQLVar^.sqltype and 1)=0, False, i+1, CP_NONE) else diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index d0b3f2bb51..a29ab92622 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/packages/fcl-db/src/sqldb/sqldb.pp @@ -1246,6 +1246,8 @@ begin FCodePage := CP_UTF8; 'win1250','cp1250': FCodePage := 1250; + 'win1251','cp1251': + FCodePage := 1251; 'win1252','cp1252','latin1','iso8859_1': FCodePage := 1252; else diff --git a/packages/fcl-web/src/base/custhttpapp.pp b/packages/fcl-web/src/base/custhttpapp.pp index 6eeb9f0ff1..41a55c45d7 100644 --- a/packages/fcl-web/src/base/custhttpapp.pp +++ b/packages/fcl-web/src/base/custhttpapp.pp @@ -197,7 +197,7 @@ end; function TCustomHTTPApplication.GetUseSSL: Boolean; begin - + Result:=HTTPHandler.UseSSL; end; procedure TCustomHTTPApplication.SetHostName(AValue: String); diff --git a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp index 3beb028200..e972747e1c 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp @@ -27,7 +27,8 @@ Type rdoCustomView, // Expose custom view /customview rdoHandleCORS, // Handle CORS requests rdoAccessCheckNeedsDB, // Authenticate after connection to database was made. - rdoConnectionResource // Enable connection managament through /_connection[/:Conn] resource + rdoConnectionResource, // Enable connection managament through /_connection[/:Conn] resource + rdoEmptyCORSDomainToOrigin // if CORSAllowedOrigins is empty CORS requests will mirror Origin instead of * // rdoServerInfo // Enable querying server info through /_serverinfo resource ); @@ -308,7 +309,7 @@ Type // General HTTP handling procedure DoRegisterRoutes; virtual; procedure DoHandleEvent(IsBefore : Boolean;IO: TRestIO); virtual; - function ResolvedCORSAllowedOrigins: String; virtual; + function ResolvedCORSAllowedOrigins(aRequest: TRequest): String; virtual; procedure HandleCORSRequest(aConnection: TSQLDBRestConnection; IO: TRestIO); virtual; procedure HandleResourceRequest(aConnection : TSQLDBRestConnection; IO: TRestIO); virtual; procedure DoHandleRequest(IO: TRestIO); virtual; @@ -322,6 +323,7 @@ Type procedure HandleMetadataRequest(aRequest : TRequest; aResponse : TResponse); procedure HandleConnRequest(aRequest : TRequest; aResponse : TResponse); procedure HandleRequest(aRequest : TRequest; aResponse : TResponse); + Procedure VerifyPathInfo(aRequest : TRequest); 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 ExposeConnection(aOwner : TComponent; Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema; @@ -409,7 +411,7 @@ Const implementation -uses fpjsonrtti, DateUtils, bufdataset, sqldbrestjson, sqldbrestconst; +uses uriparser, fpjsonrtti, DateUtils, bufdataset, sqldbrestjson, sqldbrestconst; Type @@ -492,9 +494,16 @@ end; procedure TSQLDBRestDispatcher.SetDispatchOptions(AValue: TRestDispatcherOptions); +Var + DeleteConnection : Boolean; + begin + DeleteConnection:=(rdoConnectionInURL in FDispatchOptions) and Not (rdoConnectionInURL in aValue); if (rdoConnectionResource in aValue) then - Include(aValue,rdoConnectionInURL); + if DeleteConnection then // if user disables rdoConnectionInURL, we disable rdoConnectionResource. + exclude(aValue,rdoConnectionResource) + else // else we include rdoConnectionInURL... + Include(aValue,rdoConnectionInURL); if FDispatchOptions=AValue then Exit; FDispatchOptions:=AValue; end; @@ -1617,12 +1626,33 @@ begin end end; -function TSQLDBRestDispatcher.ResolvedCORSAllowedOrigins: String; +function TSQLDBRestDispatcher.ResolvedCORSAllowedOrigins(aRequest : TRequest): String; + +Var + URl : String; + uri : TURI; begin Result:=FCORSAllowedOrigins; if Result='' then - Result:='*'; + begin + // Sent with CORS request + Result:=aRequest.GetCustomHeader('Origin'); + if (Result='') and (rdoEmptyCORSDomainToOrigin in DispatchOptions) then + begin + // Fallback + URL:=aRequest.Referer; + if (URL<>'') then + begin + uri:=ParseURI(URL,'http',0); + Result:=Format('%s://%s',[URI.Protocol,URI.Host]); + if (URI.Port<>0) then + Result:=Result+':'+IntToStr(URI.Port); + end; + end; + end; + if Result='' then + Result:='*'; end; procedure TSQLDBRestDispatcher.HandleCORSRequest(aConnection : TSQLDBRestConnection; IO : TRestIO); @@ -1644,7 +1674,7 @@ begin end else begin - IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins); + IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins(IO.Request)); S:=IO.Resource.GetHTTPAllow; IO.Response.SetCustomHeader('Access-Control-Allow-Methods',S); IO.Response.SetCustomHeader('Access-Control-Allow-Headers','x-requested-with, content-type, authorization'); @@ -1684,7 +1714,7 @@ begin Conn.OnLog:=@IO.DoSQLLog; end; if (rdoHandleCORS in DispatchOptions) then - IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins); + IO.Response.SetCustomHeader('Access-Control-Allow-Origin',ResolvedCORSAllowedOrigins(IO.Request)); if not AuthenticateRequest(IO,True) then exit; if Not CheckResourceAccess(IO) then @@ -2002,6 +2032,42 @@ begin end; end; +procedure TSQLDBRestDispatcher.VerifyPathInfo(aRequest: TRequest); +Var + Full,Path : String; + BasePaths : TStringArray; + I : Integer; + +begin + // Check & discard basepath parts of the URL + Path:=aRequest.GetNextPathInfo; + Full:=BasePath; + BasePaths:=Full.Split('/',TStringSplitOptions.ExcludeEmpty); + I:=0; + While (I'') then + aRequest.RouteParams['ID']:=Path; +end; + function TSQLDBRestDispatcher.ExposeDatabase(const aType, aHostName, aDatabaseName, aUserName, aPassword: String; aTables: array of String; aMinFieldOpts: TRestFieldOptions): TSQLDBRestConnection; diff --git a/packages/fcl-web/src/restbridge/sqldbrestconst.pp b/packages/fcl-web/src/restbridge/sqldbrestconst.pp index 6fe7820703..e45fd2dd77 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestconst.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestconst.pp @@ -52,7 +52,7 @@ Resourcestring Const DefaultAuthenticationRealm = 'REST API Server'; - ISODateTimeFormat = 'YYYY"-"mm"-"dd"T"hh":"nn":"ss"'; + ISODateTimeFormat = 'YYYY"-"mm"-"dd"T"hh":"nn":"ss'; ISODateFormat = ISODateTimeFormat; ISOTimeFormat = '"0000-00-00T"hh":"nn":"ss"'; diff --git a/packages/fcl-web/src/restbridge/sqldbrestdata.pp b/packages/fcl-web/src/restbridge/sqldbrestdata.pp index 70f196cabe..4bd2cf69c4 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestdata.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestdata.pp @@ -64,7 +64,8 @@ Type function FindFieldForParam(aOperation: TRestOperation; P: TParam): TSQLDBRestField; virtual; function BuildFieldList(ForceAll : Boolean): TRestFieldPairArray; virtual; function CreateQuery(aSQL: String): TSQLQuery; virtual; - procedure FillParams(aOperation: TRestOperation; aQuery: TSQLQuery; FilteredFields: TRestFilterPairArray); virtual; + procedure FillParams(aOperation: TRestOperation; aParams: TParams; + FilteredFields: TRestFilterPairArray); virtual; function GetDatasetForResource(aFieldList: TRestFieldPairArray; Singleton : Boolean): TDataset; virtual; function GetOrderByFieldArray: TRestFieldOrderPairArray; function GetOrderBy: UTF8String;virtual; @@ -388,7 +389,12 @@ end; procedure TSQLDBRestDBHandler.SetParamFromData(P: TParam; F: TSQLDBRestField; D: TJSONData); +Var + S : String; + begin + if Assigned(D) then + S:=D.AsString; if not Assigned(D) then P.Clear else if Assigned(F) then @@ -434,7 +440,7 @@ begin Result:=FResource.Fields.FindByFieldName(N); end; -procedure TSQLDBRestDBHandler.FillParams(aOperation : TRestOperation; aQuery: TSQLQuery;FilteredFields : TRestFilterPairArray); +procedure TSQLDBRestDBHandler.FillParams(aOperation : TRestOperation; aParams: TParams;FilteredFields : TRestFilterPairArray); Var I : Integer; @@ -452,19 +458,21 @@ begin F:=FF.Field; if FF.Operation<>rfNull then begin - P:=aQuery.Params.FindParam(FilterParamPrefix[FF.Operation]+F.FieldName); - if not Assigned(P) then - Raise ESQLDBRest.CreateFmt(IO.RestStatuses.GetStatusCode(rsError),SErrFilterParamNotFound,[F.PublicName]); - if Assigned(FF.ValueParam) then - P.Value:=FF.ValueParam.Value - else + P:=aParams.FindParam(FilterParamPrefix[FF.Operation]+F.FieldName); + // If there is no %where% macro, the parameter can be absent + if Assigned(P) then begin - D:=TJSONString.Create(FF.Value); - try - SetParamFromData(P,F,D) - finally - D.Free; - end; + if Assigned(FF.ValueParam) then + P.Value:=FF.ValueParam.Value + else + begin + D:=TJSONString.Create(FF.Value); + try + SetParamFromData(P,F,D) + finally + D.Free; + end; + end; end; end; end; @@ -477,9 +485,9 @@ begin else Sources:=AllVariableSources; end; - For I:=0 to aQuery.Params.Count-1 do + For I:=0 to aParams.Count-1 do begin - P:=aQuery.Params[i]; + P:=aParams[i]; if P.IsNull then try D:=Nil; @@ -654,7 +662,7 @@ begin Q:=CreateQuery(SQL); Try Q.UsePrimaryKeyAsKey:=False; - FillParams(roGet,Q,WhereFilterList); + FillParams(roGet,Q.Params,WhereFilterList); Result:=Q; except Q.Free; @@ -715,6 +723,23 @@ function TSQLDBRestDBHandler.GetGeneratorValue(const aGeneratorName: String ): Int64; begin +{$IFDEF VER3_0_4} + // The 'get next value' SQL in 3.0.4 is wrong, so we need to do this sep + if (IO.Connection is TSQLConnector) and SameText((IO.Connection as TSQLConnector).ConnectorType,'Sqlite3') then + begin + With CreateQuery('SELECT seq+1 FROM sqlite_sequence WHERE name=:aName') do + Try + ParamByName('aName').AsString:=aGeneratorName; + Open; + if (EOF and BOF) then + DatabaseErrorFmt('Generator %s does not exist',[aGeneratorName]); + Result:=Fields[0].asLargeint; + Finally + Free; + end; + end + else +{$ENDIF} Result:=IO.Connection.GetNextValue(aGeneratorName,1); end; @@ -870,7 +895,7 @@ begin if not IO.RESTInput.SelectObject(0) then raise ESQLDBRest.Create(IO.RestStatuses.GetStatusCode(rsInvalidParam), SErrNoResourceDataFound); InsertNewRecord; - // Now build response + // Now build response. We can imagine not doing a select again, and simply supply back the fields as sent... FieldList:=BuildFieldList(False); D:=GetDatasetForResource(FieldList,True); try @@ -887,6 +912,7 @@ procedure TSQLDBRestDBHandler.UpdateExistingRecord(OldData : TDataset); Var S : TSQLStatement; SQl : String; + WhereFilterList : TRestFilterPairArray; begin if (OldData=ExternalDataset) then @@ -902,13 +928,14 @@ begin end else begin - SQL:=FResource.GetResolvedSQl(skUpdate,'','',''); + SQL:=FResource.GetResolvedSQl(skUpdate,GetIDWhere(WhereFilterList) ,'',''); S:=TSQLStatement.Create(Self); try S.Database:=IO.Connection; S.Transaction:=IO.Transaction; S.SQL.Text:=SQL; SetPostParams(S.Params,OldData.Fields); + FillParams(roGet,S.Params,WhereFilterList); // Give user a chance to look at it. FResource.CheckParams(io.RestContext,roPut,S.Params); S.Execute; @@ -976,6 +1003,7 @@ begin // Now build response if D<>ExternalDataset then begin; + // Now build response. We can imagine not doing a select again, and simply supply back the fields as sent... FreeAndNil(D); D:=GetDatasetForResource(FieldList,True); FieldList:=BuildFieldList(False); @@ -1026,7 +1054,7 @@ begin SQL:=FResource.GetResolvedSQl(skDelete,aWhere,''); Q:=CreateQuery(SQL); try - FillParams(roDelete,Q,FilteredFields); + FillParams(roDelete,Q.Params,FilteredFields); Q.ExecSQL; if Q.RowsAffected<>1 then DoNotFound; diff --git a/packages/fcl-web/src/restbridge/sqldbrestmodule.pp b/packages/fcl-web/src/restbridge/sqldbrestmodule.pp index 0fb7cae15e..db69ab69b3 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestmodule.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestmodule.pp @@ -17,6 +17,7 @@ Type procedure SetDispatcher(AValue: TSQLDBRestDispatcher); Protected Procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure ConfigureDispatcherFromRequest(Disp: TSQLDBRestDispatcher; aRequest: TRequest); virtual; Function FindDispatcher : TSQLDBRestDispatcher; virtual; Public constructor Create(AOwner: TComponent); override; @@ -28,7 +29,7 @@ Type implementation -uses sqldbrestconst; +uses sqldbrestschema, sqldbrestconst; { TSQLDBRestModule } @@ -39,7 +40,10 @@ begin FDispatcher.RemoveFreeNotification(Self); FDispatcher:=AValue; if Assigned(Dispatcher) then + begin + FDispatcher.Active:=False; FDispatcher.FreeNotification(Self); + end; end; procedure TSQLDBRestModule.Notification(AComponent: TComponent; Operation: TOperation); @@ -61,6 +65,12 @@ begin inherited Create(AOwner); end; +procedure TSQLDBRestModule.ConfigureDispatcherFromRequest(Disp : TSQLDBRestDispatcher; aRequest : TRequest); + +begin + Disp.VerifyPathInfo(aRequest); +end; + procedure TSQLDBRestModule.HandleRequest(ARequest: TRequest; AResponse: TResponse); Var @@ -69,7 +79,11 @@ Var begin Disp:=FindDispatcher; If assigned(Disp) then + begin + Disp.Active:=False; + ConfigureDispatcherFromRequest(Disp,aRequest); Disp.HandleRequest(aRequest,aResponse) + end else Raise EHTTP.Create(SErrNoRESTDispatcher); end; diff --git a/packages/fcl-web/src/restbridge/sqldbrestschema.pp b/packages/fcl-web/src/restbridge/sqldbrestschema.pp index d30c1e0dc7..837ca7ef48 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestschema.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestschema.pp @@ -1079,7 +1079,7 @@ Const Const Wheres = [flWhereKey]; - Colons = Wheres + [flInsertParams]; + Colons = Wheres + [flInsertParams,flUpdate]; UseEqual = Wheres+[flUpdate]; Var @@ -1178,16 +1178,29 @@ Var begin Result:=aSQL; + + // from tables %FULLWHERE% if (aWhere<>'') then S:='WHERE '+aWhere else S:=''; Result:=StringReplace(Result,'%FULLWHERE%',S,[rfReplaceAll]); + + // from tables WHERE %REQUIREDWHERE% if (aWhere<>'') then S:=aWhere else S:='(1=0)'; Result:=StringReplace(Result,'%REQUIREDWHERE%',S,[rfReplaceAll]); + + // from tables WHERE X=Y %OPTIONALWHERE% + if (aWhere<>'') then + S:='AND ('+aWhere+')' + else + S:=''; + Result:=StringReplace(Result,'%OPTIONALWHERE%',S,[rfReplaceAll]); + + // from tables WHERE X=Y AND %WHERE% if (aWhere<>'') then S:='('+aWhere+')' else