From f330d2e9811b5be5c3053bfe5f95e6a2243d01eb Mon Sep 17 00:00:00 2001
From: Tomas Hajny <hajny@freepascal.org>
Date: Sat, 8 Nov 2014 00:01:13 +0000
Subject: [PATCH]   * fix for random memory corruption introduced in r28975

git-svn-id: trunk@29017 -
---
 rtl/os2/dos.pas     | 25 +++++++++++++++++++++----
 rtl/os2/sysutils.pp | 17 ++++++++++++++---
 2 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/rtl/os2/dos.pas b/rtl/os2/dos.pas
index 965ca0d98f..232434d4f4 100644
--- a/rtl/os2/dos.pas
+++ b/rtl/os2/dos.pas
@@ -202,7 +202,7 @@ var
   RC, RC2: cardinal;
   ExecAppType: cardinal;
   HQ: THandle;
-  SPID, STID, SCtr, QName: string;
+  SPID, STID, QName: string;
   SID, PID: cardinal;
   SD: TStartData;
   RD: TRequestData;
@@ -211,7 +211,8 @@ var
   Prio: byte;
   DSS: boolean;
   SR: SearchRec;
-  MaxArgsSize: word; (* Amount of memory reserved for arguments in bytes. *)
+  MaxArgsSize: PtrUInt; (* Amount of memory reserved for arguments in bytes. *)
+  MaxArgsSizeInc: word;
 
 begin
 {  LastDosExitCode := Exec (Path, ExecRunFlags (ExecFlags), efDefault, ComLine);}
@@ -225,6 +226,11 @@ begin
    QName := Path;
   FindClose (SR);
   MaxArgsSize := Length (ComLine) + Length (QName) + 256; (* More than enough *)
+  if MaxArgsSize > high (word) then
+   begin
+    DosError := 8; (* Not quite, but "not enough memory" is close enough *)
+    Exit;
+   end;
   if ComLine = '' then
    begin
     Args0 := nil;
@@ -236,8 +242,19 @@ begin
     Args := Args0;
 (* Work around a bug in OS/2 - argument to DosExecPgm *)
 (* should not cross a 64K boundary. *)
-    if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
-     Inc (pointer (Args), 1024);
+    while ((PtrUInt (Args) + MaxArgsSize) and $FFFF) < MaxArgsSize do
+     begin
+      MaxArgsSizeInc := MaxArgsSize -
+                                    ((PtrUInt (Args) + MaxArgsSize) and $FFFF);
+      Inc (MaxArgsSize, MaxArgsSizeInc);
+      if MaxArgsSize > high (word) then
+       begin
+        DosError := 8; (* Not quite, but "not enough memory" is close enough *)
+        Exit;
+       end;
+      ReallocMem (Args0, MaxArgsSize);
+      Inc (pointer (Args), MaxArgsSizeInc);
+     end;
     ArgSize := 0;
     Move (QName [1], Args^ [ArgSize], Length (QName));
     Inc (ArgSize, Length (QName));
diff --git a/rtl/os2/sysutils.pp b/rtl/os2/sysutils.pp
index 2c17e63ea3..b40559b04d 100644
--- a/rtl/os2/sysutils.pp
+++ b/rtl/os2/sysutils.pp
@@ -753,7 +753,8 @@ var
  ObjName: shortstring;
  RC: cardinal;
  ExecAppType: cardinal;
- MaxArgsSize: word; (* Amount of memory reserved for arguments in bytes. *)
+ MaxArgsSize: PtrUInt; (* Amount of memory reserved for arguments in bytes. *)
+ MaxArgsSizeInc: word;
 
 const
  ObjBufSize = 512;
@@ -849,6 +850,8 @@ begin
 (* DosExecPgm should work... *)
     begin
      MaxArgsSize := Length (ComLine) + Length (Path) + 256; (* More than enough *)
+     if MaxArgsSize > high (word) then
+      Exit;
      if ComLine = '' then
       begin
        Args0 := nil;
@@ -860,8 +863,16 @@ begin
        Args := Args0;
 (* Work around a bug in OS/2 - argument to DosExecPgm *)
 (* should not cross 64K boundary. *)
-       if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
-        Inc (pointer (Args), 1024);
+       while ((PtrUInt (Args) + MaxArgsSize) and $FFFF) < MaxArgsSize do
+        begin
+         MaxArgsSizeInc := MaxArgsSize -
+                                    ((PtrUInt (Args) + MaxArgsSize) and $FFFF);
+         Inc (MaxArgsSize, MaxArgsSizeInc);
+         if MaxArgsSize > high (word) then
+          Exit;
+         ReallocMem (Args0, MaxArgsSize);
+         Inc (pointer (Args), MaxArgsSizeInc);
+        end;
        ArgSize := 0;
        Move (Path [1], Args^ [ArgSize], Length (Path));
        Inc (ArgSize, Length (Path));