mORMot and Open Source friends
Check-in [08a6be5a26]
Check-in [08a6be5a26]
Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
| Comment: | fixed issue when some incorrect input is supplied to an interface-based service containing record parameters |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
08a6be5a267970336e67eb6d4a3158bf |
| User & Date: | User 2014-07-10 14:38:30 |
|
2014-07-11
| ||
| 09:58 | fixed LVCL compilation issues check-in: 87319e7086 user: User tags: trunk | |
|
2014-07-10
| ||
| 14:38 | fixed issue when some incorrect input is supplied to an interface-based service containing record parameters check-in: 08a6be5a26 user: User tags: trunk | |
| 14:00 | fixed issue when attributes are defined to the interface type definition of an interface-based service check-in: cef31cede1 user: User tags: trunk | |
Changes to SQLite3/mORMot.pas.
37359 37360 37361 37362 37363 37364 37365 37366 37367 37368 37369 37370 37371 37372 |
for i := 0 to ArgsUsedCount[smvvObject]-1 do
Objects[i].Free;
for i := 0 to ArgsUsedCount[smvvDynArray]-1 do
DynArrays[i].Wrapper.Clear;
if Records<>nil then begin
i := 0;
for a := 0 to high(Args) do
with Args[a] do
case ValueType of
smvRecord: begin
RecordClear(pointer(Records[i])^,TypeInfo);
inc(i);
end;
{$ifndef NOVARIANTS}
|
> > |
37359 37360 37361 37362 37363 37364 37365 37366 37367 37368 37369 37370 37371 37372 37373 37374 |
for i := 0 to ArgsUsedCount[smvvObject]-1 do
Objects[i].Free;
for i := 0 to ArgsUsedCount[smvvDynArray]-1 do
DynArrays[i].Wrapper.Clear;
if Records<>nil then begin
i := 0;
for a := 0 to high(Args) do
if Records[i]=nil then // avoid GPF in case of incorrect input
break else
with Args[a] do
case ValueType of
smvRecord: begin
RecordClear(pointer(Records[i])^,TypeInfo);
inc(i);
end;
{$ifndef NOVARIANTS}
|
Changes to SynSelfTests.pas.
731 732 733 734 735 736 737 738 739 740 741 742 743 744 ... 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 .... 9666 9667 9668 9669 9670 9671 9672 9673 9674 9675 9676 9677 9678 9679 .... 9811 9812 9813 9814 9815 9816 9817 9818 9819 9820 9821 9822 9823 9824 ..... 10009 10010 10011 10012 10013 10014 10015 10016 10017 10018 10019 10020 10021 10022 ..... 10072 10073 10074 10075 10076 10077 10078 10079 10080 10081 10082 10083 10084 10085 ..... 10345 10346 10347 10348 10349 10350 10351 10352 10353 10354 10355 10356 10357 10358 ..... 10443 10444 10445 10446 10447 10448 10449 10450 10451 10452 10453 10454 10455 10456 10457 10458 10459 |
/// a record used by IComplexCalculator.EchoRecord
TConsultaNav = object
public
MaxRows, Row0, RowCount: int64;
IsSQLUpdateBack, EOF: boolean;
end;
/// a test interface, used by TTestServiceOrientedArchitecture
// - to test basic and high-level remote service calls
ICalculator = interface(IInvokable)
['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
/// add two signed 32 bit integers
function Add(n1,n2: integer): integer;
................................................................................
{$endif}
{$ifndef LVCL}
/// test in/out collections
procedure Collections(Item: TCollTest; var List: TCollTestsI; out Copy: TCollTestsI);
{$endif}
/// returns the thread ID running the method on server side
function GetCurrentThreadID: cardinal;
{$ifdef UNICODE}
/// validate simple record transmission
// - older Delphi versions (e.g. 6-7) do not allow records without
// nested reference-counted types
function EchoRecord(const Nav: TConsultaNav): TConsultaNav;
{$endif}
end;
/// a test interface, used by TTestServiceOrientedArchitecture
// - to test sicClientDriven implementation pattern: data will remain on
// the server until the IComplexNumber instance is out of scope
................................................................................
{$endif}
{$ifndef LVCL}
procedure Collections(Item: TCollTest; var List: TCollTestsI; out Copy: TCollTestsI);
destructor Destroy; override;
{$endif LVCL}
function GetCurrentThreadID: cardinal;
function EchoRecord(const Nav: TConsultaNav): TConsultaNav;
end;
TServiceComplexNumber = class(TInterfacedObject,IComplexNumber)
private
fReal: double;
fImaginary: double;
function GetImaginary: double;
................................................................................
end;
{$endif}
function TServiceComplexCalculator.GetCurrentThreadID: cardinal;
begin
result := Windows.GetCurrentThreadId;
end;
{$ifndef LVCL}
procedure TServiceComplexCalculator.Collections(Item: TCollTest;
var List: TCollTestsI; out Copy: TCollTestsI);
begin
CopyObject(Item,List.Add);
CopyObject(List,Copy);
................................................................................
Check(RecRes.TimeStamp64=c);
Check(RecRes.JSON=StringToUTF8(Rec1.FileExtension));
CheckSame(n1,n2);
Rec1.FileExtension := ''; // to avoid memory leak
end;
end;
var s: RawUTF8;
{$ifndef LVCL}
cust: TServiceCustomAnswer;
c: cardinal;
n1,n2: double;
C1,C2,C3: TComplexNumber;
Item: TCollTest;
List,Copy: TCollTestsI;
................................................................................
2: s := QuotedStr(Int32ToUtf8(c),'"');
end;
V3 := Inst.CC.TestVariants(s,V1,V2);
CheckSame(V1,C3.Real);
CheckSame(V2,C3.Real+c);
Check(VariantSaveJSON(V3)=s);
{$endif}
{$ifdef UNICODE}
Nav.MaxRows := c;
Nav.Row0 := c*2;
Nav.RowCount := c*3;
Nav.IsSQLUpdateBack := c and 1=0;
Nav.EOF := c and 1=1;
with Inst.CC.EchoRecord(Nav) do begin
................................................................................
if IdemPChar(Pointer(result),'{"RESULT"') then
result := JSONDecode(result,'result',nil,false) else
result := copy(result,2,length(result)-2); // trim '[' + ']'
end;
var S: TServiceFactory;
i: integer;
rout: integer;
const
ROUTING: array[0..1] of TSQLRestServerURIContextClass =
(TSQLRestRoutingREST,TSQLRestRoutingJSON_RPC);
const ExpectedURI: array[0..4] of RawUTF8 =
('Add','Multiply','Subtract','ToText','ToTextFunc');
ExpectedParCount: array[0..4] of Integer = (4,4,4,3,3);
ExpectedArgs: array[0..4] of TServiceMethodValueTypes =
................................................................................
Check(Ask('None','1,2','one=1&two=2',400)='');
Check(Ask('Add','1,2','n1=1&n2=2',200)='3');
Check(Ask('Add','1,0','n2=1',200)='1');
Check(Ask('Multiply','2,3','n1=2&n2=3',200)='6');
Check(Ask('Subtract','23,20','n2=20&n1=23',200)='3');
Check(Ask('ToText','777,"abc"','result=abc&value=777',200)='777');
Check(Ask('ToTextFunc','777','value=777',200)='777');
end;
fClient.ServicesRouting := TSQLRestRoutingREST; // back to default
fClient.Server.ServicesRouting := TSQLRestRoutingREST;
end;
procedure TTestServiceOrientedArchitecture.Security;
procedure Test(Expected: TSQLFieldTables; const msg: string);
function Ask(const Method, Params: RawUTF8): RawUTF8;
var resp,data: RawUTF8;
begin
|
> > > > > > > > > > | > > > > > > > > > > > > > > > > > | |
731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 ... 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 .... 9676 9677 9678 9679 9680 9681 9682 9683 9684 9685 9686 9687 9688 9689 9690 .... 9822 9823 9824 9825 9826 9827 9828 9829 9830 9831 9832 9833 9834 9835 9836 9837 9838 9839 9840 9841 9842 9843 ..... 10028 10029 10030 10031 10032 10033 10034 10035 10036 10037 10038 10039 10040 10041 10042 ..... 10092 10093 10094 10095 10096 10097 10098 10099 10100 10101 10102 10103 10104 10105 10106 10107 10108 ..... 10368 10369 10370 10371 10372 10373 10374 10375 10376 10377 10378 10379 10380 10381 10382 ..... 10467 10468 10469 10470 10471 10472 10473 10474 10475 10476 10477 10478 10479 10480 10481 10482 10483 10484 10485 10486 |
/// a record used by IComplexCalculator.EchoRecord
TConsultaNav = object
public
MaxRows, Row0, RowCount: int64;
IsSQLUpdateBack, EOF: boolean;
end;
/// a record used by IComplexCalculator.GetCustomer
TCustomerData = packed record
Id: Integer;
AccountNum: RawUTF8;
Name: RawUTF8;
Address: RawUTF8;
end;
/// a test interface, used by TTestServiceOrientedArchitecture
// - to test basic and high-level remote service calls
ICalculator = interface(IInvokable)
['{9A60C8ED-CEB2-4E09-87D4-4A16F496E5FE}']
/// add two signed 32 bit integers
function Add(n1,n2: integer): integer;
................................................................................
{$endif}
{$ifndef LVCL}
/// test in/out collections
procedure Collections(Item: TCollTest; var List: TCollTestsI; out Copy: TCollTestsI);
{$endif}
/// returns the thread ID running the method on server side
function GetCurrentThreadID: cardinal;
/// validate record transmission
function GetCustomer(CustomerId: Integer; out CustomerData: TCustomerData): Boolean;
{$ifdef UNICODE}
/// validate simple record transmission
// - older Delphi versions (e.g. 6-7) do not allow records without
// nested reference-counted types
function EchoRecord(const Nav: TConsultaNav): TConsultaNav;
{$endif}
end;
/// a test interface, used by TTestServiceOrientedArchitecture
// - to test sicClientDriven implementation pattern: data will remain on
// the server until the IComplexNumber instance is out of scope
................................................................................
{$endif}
{$ifndef LVCL}
procedure Collections(Item: TCollTest; var List: TCollTestsI; out Copy: TCollTestsI);
destructor Destroy; override;
{$endif LVCL}
function GetCurrentThreadID: cardinal;
function EchoRecord(const Nav: TConsultaNav): TConsultaNav;
function GetCustomer(CustomerId: Integer; out CustomerData: TCustomerData): Boolean;
end;
TServiceComplexNumber = class(TInterfacedObject,IComplexNumber)
private
fReal: double;
fImaginary: double;
function GetImaginary: double;
................................................................................
end;
{$endif}
function TServiceComplexCalculator.GetCurrentThreadID: cardinal;
begin
result := Windows.GetCurrentThreadId;
end;
function TServiceComplexCalculator.GetCustomer(CustomerId: Integer;
out CustomerData: TCustomerData): Boolean;
begin
CustomerData.Id := CustomerId;
CustomerData.AccountNum := Int32ToUtf8(CustomerID);
result := True;
end;
{$ifndef LVCL}
procedure TServiceComplexCalculator.Collections(Item: TCollTest;
var List: TCollTestsI; out Copy: TCollTestsI);
begin
CopyObject(Item,List.Add);
CopyObject(List,Copy);
................................................................................
Check(RecRes.TimeStamp64=c);
Check(RecRes.JSON=StringToUTF8(Rec1.FileExtension));
CheckSame(n1,n2);
Rec1.FileExtension := ''; // to avoid memory leak
end;
end;
var s: RawUTF8;
data: TCustomerData;
{$ifndef LVCL}
cust: TServiceCustomAnswer;
c: cardinal;
n1,n2: double;
C1,C2,C3: TComplexNumber;
Item: TCollTest;
List,Copy: TCollTestsI;
................................................................................
2: s := QuotedStr(Int32ToUtf8(c),'"');
end;
V3 := Inst.CC.TestVariants(s,V1,V2);
CheckSame(V1,C3.Real);
CheckSame(V2,C3.Real+c);
Check(VariantSaveJSON(V3)=s);
{$endif}
Check(Inst.CC.GetCustomer(c,data));
Check(data.Id=c);
Check(GetInteger(pointer(data.AccountNum))=c);
{$ifdef UNICODE}
Nav.MaxRows := c;
Nav.Row0 := c*2;
Nav.RowCount := c*3;
Nav.IsSQLUpdateBack := c and 1=0;
Nav.EOF := c and 1=1;
with Inst.CC.EchoRecord(Nav) do begin
................................................................................
if IdemPChar(Pointer(result),'{"RESULT"') then
result := JSONDecode(result,'result',nil,false) else
result := copy(result,2,length(result)-2); // trim '[' + ']'
end;
var S: TServiceFactory;
i: integer;
rout: integer;
resp: RawUTF8;
const
ROUTING: array[0..1] of TSQLRestServerURIContextClass =
(TSQLRestRoutingREST,TSQLRestRoutingJSON_RPC);
const ExpectedURI: array[0..4] of RawUTF8 =
('Add','Multiply','Subtract','ToText','ToTextFunc');
ExpectedParCount: array[0..4] of Integer = (4,4,4,3,3);
ExpectedArgs: array[0..4] of TServiceMethodValueTypes =
................................................................................
Check(Ask('None','1,2','one=1&two=2',400)='');
Check(Ask('Add','1,2','n1=1&n2=2',200)='3');
Check(Ask('Add','1,0','n2=1',200)='1');
Check(Ask('Multiply','2,3','n1=2&n2=3',200)='6');
Check(Ask('Subtract','23,20','n2=20&n1=23',200)='3');
Check(Ask('ToText','777,"abc"','result=abc&value=777',200)='777');
Check(Ask('ToTextFunc','777','value=777',200)='777');
if rout=0 then
Check(fClient.URI('root/ComplexCalculator.GetCustomer?CustomerId=John%20Doe',
'POST',@resp,nil,nil).Lo=400,'incorrect input');
end;
fClient.ServicesRouting := TSQLRestRoutingREST; // back to default
fClient.Server.ServicesRouting := TSQLRestRoutingREST;
end;
procedure TTestServiceOrientedArchitecture.Security;
procedure Test(Expected: TSQLFieldTables; const msg: string);
function Ask(const Method, Params: RawUTF8): RawUTF8;
var resp,data: RawUTF8;
begin
|