* Fix possible buffer overflow (bug ID 31203)

git-svn-id: trunk@35330 -

.gitattributes

@@ -2679,6 +2679,7 @@ packages/fcl-registry/src/xregreg.inc svneol=native#text/plain
 packages/fcl-registry/tests/Makefile svneol=native#text/plain
 packages/fcl-registry/tests/Makefile.fpc -text
 packages/fcl-registry/tests/regtestframework.pp -text
+packages/fcl-registry/tests/tcxmlreg.pp svneol=native#text/plain
 packages/fcl-registry/tests/testbasics.pp svneol=native#text/plain
 packages/fcl-registry/tests/tregistry2.pp svneol=native#text/plain
 packages/fcl-res/Makefile svneol=native#text/plain

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;

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;

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

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;

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.

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

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;