paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 15:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for random memory corruption introduced in r28975

Browse Source 
git-svn-id: trunk@29017 -
This commit is contained in:
Tomas Hajny 2014-11-08 00:01:13 +00:00
parent 398fa3dd8d
commit f330d2e981
2 changed files with 35 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
rtl/os2/dos.pas
View File

@ -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));

17
rtl/os2/sysutils.pp
View File

@ -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));