- edited description
Copying variant value, Delphi to Script, causes AV
The following combination of a simple TdwsUnit class and a script function causes an AV.
Script
procedure SetValue(Value: string);
begin
end;
var DelphiObj := TDelphiClass.Create;
var v := DelphiObj.GetValue;
SetValue(v); // AV here
Delphi side
DFM
The Delphi DFM can be copied directly onto a form or datamodule (copy the text to clipboard, paste on the form).
object dwsUnit1: TdwsUnit
Classes = <
item
Name = 'TDelphiClass'
Methods = <
item
Name = 'GetValue'
ResultType = 'variant'
OnEval = dwsUnit1ClassesTDelphiClassMethodsGetValueEval
Kind = mkFunction
end>
end>
UnitName = 'xxx'
end
Implementation
procedure TDataModuleFooBar.dwsUnit1ClassesTDelphiClassMethodsGetValueEval(Info: TProgramInfo; ExtObject: TObject);
begin
Info.ResultAsVariant := 1;
end;
Call stack
System._UStrAsg(???,???)
dwsUtils.VarCopySafe('1','1')
dwsExprs.TPushOperator.ExecuteResultString($B8CEA40)
dwsExprs.TFuncExpr.DoEvalCall($B8CEA40,$F419A50)
dwsExprs.TFuncSimpleExpr.EvalNoResult($B8CEA40)
dwsCoreExprs.TBlockExpr.EvalNoResult($B8CEA40)
dwsExprs.TdwsProgramExecution.RunProgramExpr($121A3058)
dwsExprs.TdwsProgramExecution.RunProgram(0)
dwsExprs.TdwsProgramExecution.Execute(0)
Comments (8)
-
reporter -
reporter - edited description
Simplified test case
-
reporter - edited description
-
reporter The problem is with
VarCopySafe(string)
and the assumption thatVarClearSafe
zeroes the data members of the variant struct.// VarCopySafe (string) // procedure VarCopySafe(var dest : Variant; const src : UnicodeString); begin VarClearSafe(dest); TVarData(dest).VType:=varUString; UnicodeString(TVarData(dest).VString):=src; end;
The last line translates to this pseudo code:
var dest: pointer; if (dest <> nil) then string(dest)._Release; // AV here dest := src; string(dest)._AddRef
If
TVarData.VString
<> 0 when the string is assigned, then the automatic string reference counting will attempt to dereference the old string before the new is referenced. Since the address of the old string is junk we have an AV.The solution
procedure VarCopySafe(var dest : Variant; const src : UnicodeString); begin VarClearSafe(dest); TVarData(dest).VType:=varUString; TVarData(dest).VString := nil; // Add this UnicodeString(TVarData(dest).VString):=src; end;
The other variations of
VarCopySafe
that operate on managed types probably have the same problem. In particularVarCopySafe(var dest: Variant; const src: Variant);
seems to have quite a few of them. -
reporter FWIW these are the changes I applied to fix this issue:
procedure VarCopySafe(var dest : Variant; const src : Variant); begin if @dest=@src then Exit; VarClearSafe(dest); case TVarData(src).VType of varEmpty : ; varNull : TVarData(dest).VType:=varNull; varBoolean : begin TVarData(dest).VType:=varBoolean; TVarData(dest).VBoolean:=TVarData(src).VBoolean; end; varInt64 : begin TVarData(dest).VType:=varInt64; TVarData(dest).VInt64:=TVarData(src).VInt64; end; varDouble : begin TVarData(dest).VType:=varDouble; TVarData(dest).VDouble:=TVarData(src).VDouble; end; varUnknown : begin TVarData(dest).VType:=varUnknown; TVarData(dest).VUnknown:=nil; // Add this IUnknown(TVarData(dest).VUnknown):=IUnknown(TVarData(src).VUnknown); end; varDispatch : begin TVarData(dest).VType:=varDispatch; TVarData(dest).VDispatch:=nil; // Add this IDispatch(TVarData(dest).VDispatch):=IDispatch(TVarData(src).VDispatch); end; varUString : begin TVarData(dest).VType:=varUString; TVarData(dest).VUString:=nil; // Add this UnicodeString(TVarData(dest).VUString):=String(TVarData(src).VUString); end; varSmallint..varSingle, varCurrency..varDate, varError, varShortInt..varLongWord, varUInt64 : begin TVarData(dest).RawData[0]:=TVarData(src).RawData[0]; TVarData(dest).RawData[1]:=TVarData(src).RawData[1]; TVarData(dest).RawData[2]:=TVarData(src).RawData[2]; TVarData(dest).RawData[3]:=TVarData(src).RawData[3]; end; else dest:=src; end; end; procedure VarCopySafe(var dest : Variant; const src : IUnknown); begin VarClearSafe(dest); TVarData(dest).VType:=varUnknown; TVarData(dest).VUnknown:=nil; // Add this IUnknown(TVarData(dest).VUnknown):=src; end; procedure VarCopySafe(var dest : Variant; const src : IDispatch); begin VarClearSafe(dest); TVarData(dest).VType:=varDispatch; TVarData(dest).VDispatch:=nil; // Add this IDispatch(TVarData(dest).VDispatch):=src; end; procedure VarCopySafe(var dest : Variant; const src : UnicodeString); begin VarClearSafe(dest); TVarData(dest).VType:=varUString; TVarData(dest).VString:=nil; // Add this UnicodeString(TVarData(dest).VString):=src; end;
-
repo owner Good catch, thanks!
The issue seems to be more with VarClear, which does not fully clear the variant.
So VarClearSafe needs to zero the fields when VarClear is used (they are already zero'ed in the other cases). Eventually VarClear should ideally never be invoked anymore, so some variant inputs are not properly sanitized somewhere else...
(the underlying long term goal being to eliminate variants for the script engine, which can only happen when their content types are fully under control)
-
repo owner In your particular test case, the lack of input sanitization is for the
Info.ResultAsVariant := 1;
which assigns a Variant with a VarType that is not a varInt64, so the script engine uses legacy fallback code paths (which are not much tested...)
-
repo owner - changed status to closed
- Log in to comment