* Fix possible buffer overflow (bug ID 31203)

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@35330 3ad0048d-3df7-0310-abae-a5850022a9f2

7 files changed, 193 insertions, 85 deletions

diff --git a/packages/fcl-registry/src/registry.pp b/packages/fcl-registry/src/registry.pp
index f3f9d2b3f7..ef10ce8893 100644
--- a/packages/fcl-registry/src/registry.pp
+++ b/packages/fcl-registry/src/registry.pp
@@ -58,13 +58,13 @@ type
     procedure SetRootKey(Value: HKEY);
     Procedure SysRegCreate;
     Procedure SysRegFree;
-    Function  SysGetData(const Name: String; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataType): Integer;
+    Function  SysGetData(const Name: String; Buffer: Pointer; BufSize: Integer; Out RegData: TRegDataType): Integer;
     Function  SysPutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType) : Boolean;
     Function  SysCreateKey(const Key: String): Boolean;
   protected
     function GetBaseKey(Relative: Boolean): HKey;
     function GetData(const Name: string; Buffer: Pointer;
-                  BufSize: Integer; var RegData: TRegDataType): Integer;
+                  BufSize: Integer; Out RegData: TRegDataType): Integer;
     function GetKey(const Key: string): HKEY;
     procedure ChangeKey(Value: HKey; const Path: string);
     procedure PutData(const Name: string; Buffer: Pointer;
@@ -78,10 +78,10 @@ type
     function CreateKey(const Key: string): Boolean;
     function DeleteKey(const Key: string): Boolean;
     function DeleteValue(const Name: string): Boolean;
-    function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
+    function GetDataInfo(const ValueName: string; Out Value: TRegDataInfo): Boolean;
     function GetDataSize(const ValueName: string): Integer;
     function GetDataType(const ValueName: string): TRegDataType;
-    function GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+    function GetKeyInfo(Out Value: TRegKeyInfo): Boolean;
     function HasSubKeys: Boolean;
     function KeyExists(const Key: string): Boolean;
     function LoadKey(const Key, FileName: string): Boolean;
@@ -272,8 +272,7 @@ begin
     Result := RootKey;
 end;
 
-function TRegistry.GetData(const Name: string; Buffer: Pointer;
-  BufSize: Integer; var RegData: TRegDataType): Integer;
+function TRegistry.GetData(const Name: string; Buffer: Pointer; BufSize: Integer; out RegData: TRegDataType): Integer;
 begin
   Result:=SysGetData(Name,Buffer,BufSize,RegData);
   If (Result=-1) then
@@ -353,12 +352,14 @@ end;
 function TRegistry.ReadCurrency(const Name: string): Currency;
 
 begin
+  Result:=Default(Currency);
   ReadBinaryData(Name, Result, SizeOf(Currency));
 end;
 
 function TRegistry.ReadDate(const Name: string): TDateTime;
 
 begin
+  Result:=Default(TDateTime);
   ReadBinaryData(Name, Result, SizeOf(TDateTime));
   Result:=Trunc(Result);
 end;
@@ -366,12 +367,14 @@ end;
 function TRegistry.ReadDateTime(const Name: string): TDateTime;
 
 begin
+  Result:=Default(TDateTime);
   ReadBinaryData(Name, Result, SizeOf(TDateTime));
 end;
 
 function TRegistry.ReadFloat(const Name: string): Double;
 
 begin
+  Result:=Default(Double);
   ReadBinaryData(Name,Result,SizeOf(Double));
 end;
 
@@ -409,6 +412,7 @@ end;
 function TRegistry.ReadTime(const Name: string): TDateTime;
 
 begin
+  Result:=Default(TDateTime);
   ReadBinaryData(Name, Result, SizeOf(TDateTime));
   Result:=Frac(Result);
 end;
diff --git a/packages/fcl-registry/src/winreg.inc b/packages/fcl-registry/src/winreg.inc
index 20bf951e90..fd400b9438 100644
--- a/packages/fcl-registry/src/winreg.inc
+++ b/packages/fcl-registry/src/winreg.inc
@@ -78,7 +78,7 @@ begin
 end;
 
 function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
-          BufSize: Integer; var RegData: TRegDataType): Integer;
+          BufSize: Integer; Out RegData: TRegDataType): Integer;
 Var
   P: PChar;
   RD : DWord;
@@ -105,7 +105,7 @@ begin
     end;
 end;
 
-function TRegistry.GetDataInfo(const ValueName: String; var Value: TRegDataInfo): Boolean;
+function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean;
 
 Var
   P: PChar;
@@ -143,7 +143,7 @@ begin
 end;
 
 
-function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+function TRegistry.GetKeyInfo(out Value: TRegKeyInfo): Boolean;
 var
   winFileTime: Windows.FILETIME;
   sysTime: TSystemTime;
diff --git a/packages/fcl-registry/src/xmlreg.pp b/packages/fcl-registry/src/xmlreg.pp
index 797a1f4225..c40edeca96 100644
--- a/packages/fcl-registry/src/xmlreg.pp
+++ b/packages/fcl-registry/src/xmlreg.pp
@@ -61,8 +61,8 @@ Type
     Function  CreateKey(KeyPath : String) : Boolean;
     Function  GetValueSize(Name : String) : Integer;
     Function  GetValueType(Name : String) : TDataType;
-    Function  GetValueInfo(Name : String; Var Info : TDataInfo) : Boolean;
-    Function  GetKeyInfo(Var Info : TKeyInfo) : Boolean;
+    Function  GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean;
+    Function  GetKeyInfo(Out Info : TKeyInfo) : Boolean;
     Function  EnumSubKeys(List : TStrings) : Integer;
     Function  EnumValues(List : TStrings) : Integer;
     Function  KeyExists(KeyPath : String) : Boolean;
@@ -71,7 +71,7 @@ Type
     Function  DeleteValue(S : String) : Boolean;
     Procedure Flush;
     Procedure Load;
-    Function GetValueData(Name : String; Var DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+    Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
     Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
     Property FileName : String Read FFileName Write SetFileName;
     Property RootKey : String Read FRootKey Write SetRootkey;
@@ -285,7 +285,7 @@ begin
   MaybeFlush;
 end;
 
-Function TXmlRegistry.GetValueData(Name : String; Var DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
+Function TXmlRegistry.GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
 
 Type
   PCardinal = ^Cardinal;
@@ -293,7 +293,7 @@ Type
 Var
   Node  : TDomElement;
   DataNode : TDomNode;
-  ND : Integer;
+  BL,ND,NS : Integer;
   S : UTF8String;
   HasData: Boolean;
   IntValue: Integer;
@@ -309,38 +309,37 @@ begin
     If Result then
       begin
       DataType:=TDataType(ND);
+      NS:=0; // Initialize, for optional nodes.
       Case DataType of
         dtDWORD : begin   // DataNode is required
-                  if HasData and TryStrToInt(DataNode.NodeValue,IntValue) then
-                    begin
+                  NS:=SizeOf(Cardinal);
+                  Result:=HasData and TryStrToInt(DataNode.NodeValue,IntValue) and (DataSize>=NS);
+                  if Result then
                     PCardinal(@Data)^:=IntValue;
-                    DataSize:=SizeOf(Cardinal);
-                    end
-                  else
-                    Result:=False;
                   end;
-        dtString : begin  // DataNode is optional
+        dtString : // DataNode is optional
                    if HasData then
                      begin
                      S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring
-                     DataSize:=Length(S);
-                     if (DataSize>0) then
-                       Move(S[1],Data,DataSize);
-                     end
-                   else
-                     DataSize:=0;
-                   end;
-        dtBinary : begin  // DataNode is optional
+                     NS:=Length(S);
+                     Result:=(DataSize>=NS);
+                     if Result then
+                       Move(S[1],Data,NS);
+                     end;
+
+        dtBinary : // DataNode is optional
                    if HasData then
                      begin
-                     DataSize:=Length(DataNode.NodeValue);
-                     If (DataSize>0) then
-                       HexToBuf(DataNode.NodeValue,Data,DataSize);
-                     end
-                   else
-                     DataSize:=0;
-                   end;
+                     BL:=Length(DataNode.NodeValue);
+                     NS:=BL div 2;
+                     Result:=DataSize>=NS;
+                     If Result then
+                       // No need to check for -1, We checked NS before calling.
+                       NS:=HexToBuf(DataNode.NodeValue,Data,BL);
+                     end;
       end;
+      // Report needed/used size in all cases
+      DataSize:=NS;
       end;
     end;
 end;
@@ -539,16 +538,21 @@ end;
 Function TXMLRegistry.hexToBuf(Const Str : String; Var Buf; Var Len : Integer ) : Integer;
 
 Var
-  I : Integer;
+  NLeN,I : Integer;
   P : PByte;
   S : String;
   B : Byte;
   Code : Integer;
 
 begin
-  P:=@Buf;
-  Len:= Length(Str) div 2;
   Result:=0;
+  P:=@Buf;
+  NLen:= Length(Str) div 2;
+  If (NLen>Len) then
+    begin
+    Len:=NLen;
+    Exit(-1);
+    end;
   For I:=0 to Len-1 do
     begin
     S:='$'+Copy(Str,(I*2)+1,2);
@@ -602,7 +606,7 @@ begin
     Result:=dtUnknown;
 end;
 
-Function TXMLRegistry.GetValueInfo(Name : String; Var Info : TDataInfo) : Boolean;
+Function TXMLRegistry.GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean;
 
 Var
   N  : TDomElement;
@@ -633,14 +637,14 @@ begin
     end;
 end;
 
-Function  TXMLRegistry.GetKeyInfo(Var Info : TKeyInfo) : Boolean;
+Function  TXMLRegistry.GetKeyInfo(Out Info : TKeyInfo) : Boolean;
 
 Var
   Node,DataNode : TDOMNode;
   L    : Integer;
 
 begin
-  FillChar(Info,SizeOf(Info),0);
+  Info:=Default(TKeyInfo);
   Result:=FCurrentElement<>Nil;
   If Result then
     With Info do
diff --git a/packages/fcl-registry/src/xregreg.inc b/packages/fcl-registry/src/xregreg.inc
index b93b12d0ad..ab155b7d45 100644
--- a/packages/fcl-registry/src/xregreg.inc
+++ b/packages/fcl-registry/src/xregreg.inc
@@ -118,7 +118,7 @@ begin
 end;
 
 function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
-          BufSize: Integer; var RegData: TRegDataType): Integer;
+          BufSize: Integer; Out RegData: TRegDataType): Integer;
 
 Var
   DataType : TDataType;
@@ -138,8 +138,7 @@ begin
 end;
 
 
-function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo
-  ): Boolean;
+function TRegistry.GetDataInfo(const ValueName: string; out Value: TRegDataInfo): Boolean;
 
 Var
   Info : TDataInfo;
@@ -170,7 +169,7 @@ begin
   Result := 0;
 end;
 
-function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
+function TRegistry.GetKeyInfo(Out Value: TRegKeyInfo): Boolean;
 
 Var
   Info : TKeyInfo;
diff --git a/packages/fcl-registry/tests/regtestframework.pp b/packages/fcl-registry/tests/regtestframework.pp
index dcd6af419e..573fa4828b 100644
--- a/packages/fcl-registry/tests/regtestframework.pp
+++ b/packages/fcl-registry/tests/regtestframework.pp
@@ -1,53 +1,31 @@
 program regtestframework;

 

 {$IFDEF FPC}

-  {$mode objfpc}{$H+}

+{$mode objfpc}{$H+}

 {$ENDIF}

 

-{ $DEFINE STOREDB}

-

+{$IFDEF WINDOWS}

 {$APPTYPE CONSOLE}

+{$ENDIF}

 

 uses

   SysUtils,

   fpcunit,  testreport, testregistry,

-{$IFDEF STOREDB}

-  DBResultsWriter,

-{$ENDIF}

 // Units wich contains the tests

-  testbasics;

+  tcxmlreg,

+  testbasics, consoletestrunner;

+

+Var

+  A : TTestRunner;

 

-var

-  FXMLResultsWriter: TXMLResultsWriter;

-{$IFDEF STOREDB}

-  FDBResultsWriter: TDBResultsWriter;

-{$ENDIF}

-  testResult: TTestResult;

 begin

-  testResult := TTestResult.Create;

-  FXMLResultsWriter := TXMLResultsWriter.Create;

-{$IFDEF STOREDB}

-  FDBResultsWriter := TDBResultsWriter.Create;

-{$ENDIF}

+  DefaultFormat:=fPlain;

+  DefaultRunAllTests:=True;

+  A:=TTestRunner.Create(Nil);

   try

-    testResult.AddListener(FXMLResultsWriter);

-{$IFDEF STOREDB}

-    testResult.AddListener(FDBResultsWriter);

-{$ENDIF}

-    FXMLResultsWriter.WriteHeader;

-{$IFDEF STOREDB}

-    FDBResultsWriter.OpenConnection(dbconnectorname+';'+dbconnectorparams);

-{$ENDIF}

-    GetTestRegistry.Run(testResult);

-    FXMLResultsWriter.WriteResult(testResult);

-{$IFDEF STOREDB}

-    FDBResultsWriter.CloseConnection;

-{$ENDIF}

+    A.Initialize;

+    A.Run;

   finally

-    testResult.Free;

-    FXMLResultsWriter.Free;

-{$IFDEF STOREDB}

-    FDBResultsWriter.Free;

-{$ENDIF}

+    A.Free;

   end;

 end.

diff --git a/packages/fcl-registry/tests/tcxmlreg.pp b/packages/fcl-registry/tests/tcxmlreg.pp
new file mode 100644
index 0000000000..e5ff2d79c3
--- /dev/null
+++ b/packages/fcl-registry/tests/tcxmlreg.pp
@@ -0,0 +1,111 @@
+unit tcxmlreg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  fpcunit, testutils, testregistry, testdecorator, Classes, SysUtils, xmlreg;
+
+Type
+
+  { TTestXMLRegistry }
+
+  TTestXMLRegistry = Class(TTestCase)
+  private
+    FXMLReg: TXmlRegistry;
+  Protected
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    Property XMLReg : TXmlRegistry Read FXMLReg;
+  Published
+    Procedure TestReadBufDataDWord;
+    Procedure TestReadBufDataString;
+    Procedure TestReadBufDataBinary;
+  end;
+
+
+implementation
+
+{ TTestXMLRegistry }
+
+procedure TTestXMLRegistry.Setup;
+begin
+  inherited Setup;
+  DeleteFile('test.xml');
+  FXMLReg:=TXmlRegistry.Create('test.xml');
+end;
+
+procedure TTestXMLRegistry.TearDown;
+begin
+  FreeAndNil(FXMLReg);
+  inherited TearDown;
+end;
+
+procedure TTestXMLRegistry.TestReadBufDataDWord;
+
+Var
+  C : Cardinal;
+  I : Smallint;
+  DS : Integer;
+  dt : TDataType;
+
+begin
+  XMLReg.SetKey('a',True);
+  C:=123456;
+  XMLReg.SetValueData('b',dtDWORD,C,SizeOf(C));
+  XMLReg.Flush;
+  DS:=SizeOf(SmallInt);
+  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,I,ds));
+  AssertTrue('Correct data type reported',dt=dtDWord);
+  AssertEquals('Correct data buffer size reported',SizeOf(C),DS);
+
+end;
+
+procedure TTestXMLRegistry.TestReadBufDataString;
+
+Var
+  S1,S2 : String;
+  I : Smallint;
+  DS : Integer;
+  dt : TDataType;
+
+begin
+  XMLReg.SetKey('a',True);
+  S1:=StringOfChar('*',100);
+  XMLReg.SetValueData('b',dtString,S1[1],Length(S1));
+  XMLReg.Flush;
+  DS:=SizeOf(S1) div 2;
+  S2:=StringOfChar('*',DS);
+  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,S2[1],ds));
+  AssertTrue('Correct data type reported',dt=dtString);
+  AssertEquals('Correct data buffer size reported',Length(S1),DS);
+end;
+
+procedure TTestXMLRegistry.TestReadBufDataBinary;
+Var
+  S1,S2 : Array of byte;
+  I : Smallint;
+  DS : Integer;
+  dt : TDataType;
+
+begin
+  XMLReg.SetKey('a',True);
+  SetLength(S1,100);
+  For I:=0 to 99 do
+    S1[I]:=i;
+  XMLReg.SetValueData('b',dtBinary,S1[1],Length(S1));
+  XMLReg.Flush;
+  DS:=SizeOf(S1) div 4;
+  SetLength(S2,DS);
+  For I:=0 to DS-1 do
+    S2[I]:=i;
+  AssertEquals('Cannot read, buffer size too small',False,XMLReg.GetValueData('b',dt,S2[1],ds));
+  AssertTrue('Correct data type reported',dt=dtBinary);
+  AssertEquals('Correct data buffer size reported',Length(S1),DS);
+end;
+
+begin
+  RegisterTest(TTestXMLRegistry);
+end.
+
diff --git a/packages/fcl-registry/tests/testbasics.pp b/packages/fcl-registry/tests/testbasics.pp
index 0709263bd0..d78d4e2b5b 100644
--- a/packages/fcl-registry/tests/testbasics.pp
+++ b/packages/fcl-registry/tests/testbasics.pp
@@ -7,8 +7,7 @@ unit TestBasics;
 interface
 
 uses
-  fpcunit, testutils, testregistry, testdecorator,
-  Classes, SysUtils;
+  fpcunit, testutils, testregistry, testdecorator, Classes, SysUtils;
 
 type
 
@@ -97,7 +96,7 @@ end;
 procedure TTestBasics.bug16395;
 var
   r: TRegistry;
-  s: string;
+  s,t: string;
 begin
   DeleteUserXmlFile;
   
@@ -149,6 +148,19 @@ begin
     r.Free;
   end;
 
+  r := TRegistry.Create;
+  try
+    r.RootKey := HKEY_CURRENT_USER;
+    r.OpenKey('LongNode',true);
+    t:=StringOfChar('*',4000);
+    r.WriteString('LongString',T);
+    s := r.ReadString('LongString');
+    AssertEquals('Writing long string works OK', t, s);
+    r.CloseKey;
+  finally
+    r.Free;
+  end;
+
   DeleteUserXmlFile;
 end;