Copying variant value, Delphi to Script, causes AV

[Anders Melander]

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)

[Anders Melander]

Simplified test case

[Anders Melander]

The problem is with VarCopySafe(string) and the assumption that VarClearSafe 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 particular VarCopySafe(var dest: Variant; const src: Variant); seems to have quite a few of them.

[Anders Melander]

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;

[Eric Grange]

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)

[Eric Grange]

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...)