[fpc-pascal] Processing passwords etc.
Michael Van Canneyt
michael at freepascal.org
Sun Apr 13 09:02:15 CEST 2014
On Sun, 13 Apr 2014, Ludo Brands wrote:
> On 04/12/2014 02:24 PM, Michael Van Canneyt wrote:
>
>>
>> Attached is an implementation that allows you to specify:
>>
>
> A few comments:
> - allocmem already zeros the memory. No need to do it a second time
Indeed, copy&paste from getmem. Removed the zeroing.
> - Getmem and Allocmem can return nil (dependent on mem manager,
> sometimes on ReturnNilIfGrowHeapfails). A test in ZeroMem and RandomMem
> on nil would be "Safe".
Indeed :) Good point, I have added this check :)
> - SafeReAllocMem doesn't clear/scramble the memory in case a realloc
> moves the memory block to a different place.
You are right. A logic error. ReallocMem is the more tricky one.
Revised.
That's why I post such quick code; for peer review.
Thanks for pointing these out, revised version attached.
Again, comments/reviews welcome.
Michael.
-------------- next part --------------
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
"Safe" Heap manager interface section
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
unit safemmgr;
interface
Type
TMemAction = (
maZero, // Zero out the memory
maRandom, // Fill with Random data
maNone // Do nothing
);
Var
// Can be set at any time.
GetAction : TMemAction = maZero;
FreeAction : TMemAction = maZero;
// You can set/unset the memory manager at any time, but it is set during intialization.
Procedure InitSafeMemManager;
Procedure DoneSafeMemManager;
Implementation
Var
M : TMemoryManager;
Procedure ZeroMem(Mem : PByte; ASize : ptruint);
begin
if (Mem=Nil) or (Asize=0) then exit;
FillWord(Mem^,ASize div 2,0);
if (ASize mod 2)=1 then
Mem[ASize-1]:=0;
end;
Procedure RandomMem(Mem : PByte; ASize : ptruint);
Var
I : ptruint;
PW : PWord;
begin
if (Mem=Nil) or (Asize=0) then exit;
PW:=PWord(Mem);
For I:=0 to (ASize div 2) do
PW[I]:=Random($FFFF);
if (ASize mod 2)=1 then
Mem[ASize-1]:=Random($FF);
end;
Function SafeGetmem (Size:ptruint):Pointer;
begin
Result:=M.Getmem(Size);
Case GetAction of
maZero : ZeroMem(Result,Size);
maRandom : RandomMem(Result,Size);
end;
end;
Function SafeFreeMemSize(p:pointer;Size:ptruint):ptruint;
begin
Case FreeAction of
maZero : ZeroMem(P,Size);
maRandom : RandomMem(P,Size);
end;
Result:=M.FreeMemSize(P,Size);
end;
Function SafeFreeMem (p:pointer):ptruint;
begin
Result:=SafeFreeMemSize(P,M.MemSize(P));
end;
Function SafeAllocMem (Size:ptruint):Pointer;
begin
Result:=M.AllocMem(Size);
Case GetAction of
maRandom : RandomMem(Result,Size);
end;
end;
Function SafeReAllocMem(var p:pointer;Size:ptruint):Pointer;
Var
OP : PByte;
GOS,FOS : ptruint;
begin
OP:=P;
FOS:=M.MemSize(P);
GOS:=FOS;
Result:=M.ReAllocMem(P,Size);
If (P=OP) then
if (FOS>Size) then
begin
Inc(OP,FOS);
Dec(FOS,Size);
end
else
OP:=Nil;
if (OP<>Nil) and (FOS>0) then
Case FreeAction of
maZero : ZeroMem(OP,FOS);
maRandom : RandomMem(OP,FOS);
end;
if (P<>OP) or (GOS<Size) then
begin
OP:=Result;
Inc(OP,GOS);
Dec(GOS,Size);
Case GetAction of
maZero : ZeroMem(OP,GOS);
maRandom : RandomMem(OP,GOS);
end;
end;
end;
Function SafeMMinstalled : Boolean;
Var
CM : TMemoryManager;
begin
FillChar(CM,SizeOf(TMemoryManager),#0);
GetMemoryManager(CM);
Result:=Pointer(CM.AllocMem)=Pointer(@SafeAllocMem);
end;
Procedure InitSafeMemManager;
Var
NM : TMemoryManager;
begin
If SafeMMInstalled then
exit;
GetMemoryManager(M);
NM:=M;
NM.FreeMem:=@SafeFreeMem;
NM.FreeMemSize:=@SafeFreeMemSize;
NM.GetMem:=@SafeGetMem;
NM.AllocMem:=@SafeAllocMem;
NM.ReAllocMem:=@SafeReAllocMem;
SetMemoryManager(NM);
end;
Procedure DoneSafeMemManager;
begin
If Not SafeMMInstalled then
exit;
SetMemoryManager(M);
end;
initialization
InitSafeMemManager;
finalization
DoneSafeMemManager;
end.
More information about the fpc-pascal
mailing list