unit UFileStorage;

{$MODE Delphi}

Classes, {$IFnDEF FPC}Windows,{$ENDIF} UBlockChain, SyncObjs, UThread, UAccounts, UCrypto, UPCDataTypes;

TBlockHeader = Record

BlockNumber : Cardinal;

StreamBlockRelStartPos : Int64;

BlockSize : Cardinal;

end; // 16 bytes

TArrayOfInt64 = Array of Int64;

{ TFileStorage }

TFileStorage = Class(TStorage)

private

FLowMemoryUsage: Boolean;

FStorageLock : TPCCriticalSection;

FBlockChainStream : TFileStream;

FPendingBufferOperationsStream : TFileStream;

FStreamFirstBlockNumber : Int64;

FStreamLastBlockNumber : Int64;

FBlockHeadersFirstBytePosition : TArrayOfInt64;

FDatabaseFolder: AnsiString;

FBlockChainFileName : AnsiString;

Function StreamReadBlockHeader(Stream: TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock, Block: Cardinal; CanSearchBackward : Boolean; var BlockHeader : TBlockHeader): Boolean;

Function StreamBlockRead(Stream : TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock, Block : Cardinal; Operations : TPCOperationsComp) : Boolean;

Function StreamBlockSave(Stream : TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock : Cardinal; Operations : TPCOperationsComp) : Boolean;

Function GetFolder(Const AOrphan : TOrphan): AnsiString;

Function GetBlockHeaderFirstBytePosition(Stream : TStream; Block : Cardinal; CanInitialize : Boolean; var iBlockHeaders : Integer; var BlockHeaderFirstBlock : Cardinal) : Boolean;

Function GetBlockHeaderFixedSize : Int64;

procedure SetDatabaseFolder(const Value: AnsiString);

Procedure ClearStream;

Procedure GrowStreamUntilPos(Stream : TStream; newPos : Int64; DeleteDataStartingAtCurrentPos : Boolean);

Function GetPendingBufferOperationsStream : TFileStream;

protected

procedure SetReadOnly(const Value: Boolean); override;

procedure SetOrphan(const Value: TOrphan); override;

Function DoLoadBlockChain(Operations : TPCOperationsComp; Block : Cardinal) : Boolean; override;

Function DoSaveBlockChain(Operations : TPCOperationsComp) : Boolean; override;

Function DoMoveBlockChain(Start_Block : Cardinal; Const DestOrphan : TOrphan; DestStorage : TStorage) : Boolean; override;

Function DoSaveBank : Boolean; override;

Function DoRestoreBank(max_block : Int64; restoreProgressNotify : TProgressNotify) : Boolean; override;

Procedure DoDeleteBlockChainBlocks(StartingDeleteBlock : Cardinal); override;

Function DoBlockExists(Block : Cardinal) : Boolean; override;

Function LockBlockChainStream : TFileStream;

Procedure UnlockBlockChainStream;

Function LoadBankFileInfo(Const Filename : AnsiString; var safeBoxHeader : TPCSafeBoxHeader) : Boolean;

function GetFirstBlockNumber: Int64; override;

function GetLastBlockNumber: Int64; override;

function DoInitialize : Boolean; override;

Function DoOpenSafeBoxCheckpoint(blockCount : Cardinal) : TCheckPointStruct; override;

Procedure DoEraseStorage; override;

Procedure DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;

Procedure DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree); override;

public

Constructor Create(AOwner : TComponent); Override;

Destructor Destroy; Override;

Class Function GetSafeboxCheckpointingFileName(Const BaseDataFolder : AnsiString; block : Cardinal) : AnsiString;

Property DatabaseFolder : AnsiString read FDatabaseFolder write SetDatabaseFolder;

Procedure CopyConfiguration(Const CopyFrom : TStorage); override;

Procedure SetBlockChainFile(BlockChainFileName : AnsiString);

Function HasUpgradedToVersion2 : Boolean; override;

Procedure CleanupVersion1Data; override;

property LowMemoryUsage : Boolean read FLowMemoryUsage write FLowMemoryUsage;

End;

Uses ULog, SysUtils, UBaseTypes,

{$IFDEF USE_ABSTRACTMEM}

UPCAbstractMem,

{$ENDIF}

UConst;

Const CT_TBlockHeader_NUL : TBlockHeader = (BlockNumber:0;StreamBlockRelStartPos:0;BlockSize:0);

CT_Safebox_Extension = {$IFDEF USE_ABSTRACTMEM}'.am_safebox'{$ELSE}'.safebox'{$ENDIF};

CT_GroupBlockSize = 1000;

CT_SizeOfBlockHeader = 16;

{

function TFileStorage.DoBlockExists(Block: Cardinal): Boolean;

Var iBlockHeaders : Integer;

BlockHeaderFirstBlock : Cardinal;

stream : TStream;

BlockHeader : TBlockHeader;

Result := false;

BlockHeader := CT_TBlockHeader_NUL;

iBlockHeaders:=0; BlockHeaderFirstBlock:=0;

stream := LockBlockChainStream;

try

if Not GetBlockHeaderFirstBytePosition(stream,Block,False,iBlockHeaders,BlockHeaderFirstBlock) then exit;

if not StreamReadBlockHeader(stream,iBlockHeaders,BlockHeaderFirstBlock,Block,False,BlockHeader) then exit;

Result := (BlockHeader.BlockNumber = Block) And

(BlockHeader.BlockSize>0);

finally

UnlockBlockChainStream;

end;

end;

procedure TFileStorage.ClearStream;

FreeAndNil(FBlockChainStream);

FreeAndNil(FPendingBufferOperationsStream);

FStreamFirstBlockNumber := 0;

FStreamLastBlockNumber := -1;

SetLength(FBlockHeadersFirstBytePosition,0);

end;

procedure TFileStorage.GrowStreamUntilPos(Stream : TStream; newPos: Int64; DeleteDataStartingAtCurrentPos: Boolean);

Var null_buff : Array[1..CT_GroupBlockSize] of Byte;

i,antPos,antSize : Int64;

antPos := Stream.Position;

antSize := Stream.Size;

if Not DeleteDataStartingAtCurrentPos then begin

Stream.Position := Stream.Size;

end;

if (stream.Position<newPos) then begin

FillChar(null_buff,length(null_buff),0);

while (Stream.Position<newPos) do begin

i := newPos - Stream.Position;

if i>length(null_buff) then i := length(null_buff);

Stream.WriteBuffer(null_buff,i);

end;

end;

Stream.Position := newPos;

end;

function TFileStorage.GetPendingBufferOperationsStream: TFileStream;

Var fs : TFileStream;

fn : TFileName;

fm : Word;

If Not Assigned(FPendingBufferOperationsStream) then begin

fn := GetFolder(Orphan)+PathDelim+'pendingbuffer.ops';

If FileExists(fn) then fm := fmOpenReadWrite+fmShareExclusive

else fm := fmCreate+fmShareExclusive;

Try

FPendingBufferOperationsStream := TFileStream.Create(fn,fm);

Except

On E:Exception do begin

TLog.NewLog(ltError,ClassName,'Error opening PendingBufferOperationsStream '+fn+' ('+E.ClassName+'):'+ E.Message);

Raise;

end;

end;

end;

Result := FPendingBufferOperationsStream;

end;

procedure TFileStorage.CopyConfiguration(const CopyFrom: TStorage);

inherited;

if CopyFrom is TFileStorage then begin

DatabaseFolder := TFileStorage(CopyFrom).DatabaseFolder;

end;

end;

constructor TFileStorage.Create(AOwner: TComponent);

inherited;

FLowMemoryUsage := False;

FDatabaseFolder := '';

FBlockChainFileName := '';

FBlockChainStream := Nil;

SetLength(FBlockHeadersFirstBytePosition,0);

FStreamFirstBlockNumber := 0;

FStreamLastBlockNumber := -1;

FPendingBufferOperationsStream := Nil;

FStorageLock := TPCCriticalSection.Create('TFileStorage_StorageLock');

end;

destructor TFileStorage.Destroy;

inherited;

ClearStream;

FreeAndNil(FStorageLock);

end;

procedure TFileStorage.DoDeleteBlockChainBlocks(StartingDeleteBlock: Cardinal);

Var stream : TStream;

iBlockHeaders : Integer;

BlockHeaderFirstBlock : Cardinal;

_Header : TBlockHeader;

_intBlockIndex : Cardinal;

p : Int64;

stream := LockBlockChainStream;

Try

if Not GetBlockHeaderFirstBytePosition(stream,StartingDeleteBlock,False,iBlockHeaders,BlockHeaderFirstBlock) then exit;

If Not StreamReadBlockHeader(Stream,iBlockHeaders,BlockHeaderFirstBlock,StartingDeleteBlock,True,_Header) then exit;

_intBlockIndex := (_Header.BlockNumber-BlockHeaderFirstBlock);

TLog.NewLog(ltInfo,ClassName,Format('Deleting Blockchain block %d',[StartingDeleteBlock]));

p := FBlockHeadersFirstBytePosition[iBlockHeaders] + (Int64(_intBlockIndex) * Int64(CT_SizeOfBlockHeader));

Stream.Position:=p;

// Write null data until end of header

GrowStreamUntilPos(Stream,FBlockHeadersFirstBytePosition[iBlockHeaders] + GetBlockHeaderFixedSize,true);

// Force to clean Block Headers future rows

SetLength(FBlockHeadersFirstBytePosition,iBlockHeaders+1); // Force to clear future blocks on next Block Headers row (Bug solved on 2.1.8)

FStreamLastBlockNumber:=Int64(StartingDeleteBlock)-1;

// End Stream at _Header

Stream.Size := Stream.Position + _Header.StreamBlockRelStartPos;

Finally

UnlockBlockChainStream;

End;

end;

function TFileStorage.DoInitialize: Boolean;

Var stream : TStream;

stream := LockBlockChainStream;

Try

Result := true;

Finally

UnlockBlockChainStream;

End;

end;

function TFileStorage.DoOpenSafeBoxCheckpoint(blockCount: Cardinal): TCheckPointStruct;

var fn : TFilename;

err : AnsiString;

Result := Nil;

fn := GetSafeboxCheckpointingFileName(GetFolder(Orphan),blockCount);

If (fn<>'') and (FileExists(fn)) then begin

{$IFDEF USE_ABSTRACTMEM}

Result := TPCAbstractMem.Create(fn,True);

{$ELSE}

Result := TFileStream.Create(fn,fmOpenRead+fmShareDenyWrite);

{$ENDIF}

end;

If Not Assigned(Result) then begin

err := 'Cannot load SafeBoxStream (block:'+IntToStr(blockCount)+') file:'+fn;

TLog.NewLog(ltError,ClassName,err);

end;

end;

procedure TFileStorage.DoEraseStorage;

Var stream : TStream;

stream := LockBlockChainStream;

try

stream.Size:=0; // Erase

ClearStream;

finally

UnlockBlockChainStream;

end;

end;

procedure TFileStorage.DoSavePendingBufferOperations(OperationsHashTree : TOperationsHashTree);

Var fs : TFileStream;

LockBlockChainStream;

Try

fs := GetPendingBufferOperationsStream;

fs.Position:=0;

fs.Size:=0;

OperationsHashTree.SaveOperationsHashTreeToStream(fs,true);

{$IFDEF HIGHLOG}TLog.NewLog(ltdebug,ClassName,Format('DoSavePendingBufferOperations operations:%d',[OperationsHashTree.OperationsCount]));{$ENDIF}

finally

UnlockBlockChainStream;

end;

end;

procedure TFileStorage.DoLoadPendingBufferOperations(OperationsHashTree : TOperationsHashTree);

Var fs : TFileStream;

errors : String;

n : Integer;

LCurrentProtocol : Word;

LockBlockChainStream;

Try

fs := GetPendingBufferOperationsStream;

fs.Position:=0;

if fs.Size>0 then begin

if Assigned(Bank) then LCurrentProtocol := Bank.SafeBox.CurrentProtocol

else LCurrentProtocol := CT_BUILD_PROTOCOL;

If OperationsHashTree.LoadOperationsHashTreeFromStream(fs,true,LCurrentProtocol,LCurrentProtocol, Nil,errors) then begin

TLog.NewLog(ltInfo,ClassName,Format('DoLoadPendingBufferOperations loaded operations:%d',[OperationsHashTree.OperationsCount]));

end else TLog.NewLog(ltError,ClassName,Format('DoLoadPendingBufferOperations ERROR (Protocol %d): loaded operations:%d errors:%s',[LCurrentProtocol,OperationsHashTree.OperationsCount,errors]));

end;

finally

UnlockBlockChainStream;

end;

end;

function TFileStorage.DoLoadBlockChain(Operations: TPCOperationsComp; Block: Cardinal): Boolean;

Var stream : TStream;

iBlockHeaders : Integer;

BlockHeaderFirstBlock : Cardinal;

Result := False;

stream := LockBlockChainStream;

Try

if Not GetBlockHeaderFirstBytePosition(stream,Block,False,iBlockHeaders,BlockHeaderFirstBlock) then exit;

Result := StreamBlockRead(stream,iBlockHeaders,BlockHeaderFirstBlock,Block,Operations);

Finally

UnlockBlockChainStream;

End;

end;

Procedure DoCopyFile(sourcefn,destfn : AnsiString);

var sourceFS, destFS : TFileStream;

if Not FileExists(sourcefn) then Raise Exception.Create('Source file not found: '+sourcefn);

sourceFS := TFileStream.Create(sourcefn,fmOpenRead+fmShareDenyNone);

try

sourceFS.Position:=0;

destFS := TFileStream.Create(destfn,fmCreate+fmShareDenyWrite);

try

destFS.Size:=0;

destFS.CopyFrom(sourceFS,sourceFS.Size);

finally

destFS.Free;

end;

finally

sourceFS.Free;

end;

end;

function TFileStorage.DoMoveBlockChain(Start_Block: Cardinal; const DestOrphan: TOrphan; DestStorage : TStorage): Boolean;

Procedure DoCopySafebox;

var sr: TSearchRec;

FileAttrs: Integer;

folder : AnsiString;

sourcefn,destfn : AnsiString;

begin

FileAttrs := faArchive;

folder := GetFolder(Orphan);

if SysUtils.FindFirst(GetFolder(Orphan)+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin

repeat

if (sr.Attr and FileAttrs) = FileAttrs then begin

sourcefn := GetFolder(Orphan)+PathDelim+sr.Name;

destfn := GetFolder('')+PathDelim+sr.Name;

TLog.NewLog(ltInfo,ClassName,'Copying safebox file '+sourcefn+' to '+destfn);

Try

DoCopyFile(sourcefn,destfn);

Except

On E:Exception do begin

TLog.NewLog(ltError,Classname,'Error copying file: ('+E.ClassName+') '+E.Message);

end;

End;

end;

until FindNext(sr) <> 0;

FindClose(sr);

end;

End;

Var db : TFileStorage;

i : Integer;

ops : TPCOperationsComp;

b : Cardinal;

Try

if (Assigned(DestStorage)) And (DestStorage is TFileStorage) then db := TFileStorage(DestStorage)

else db := Nil;

try

if Not assigned(db) then begin

db := TFileStorage.Create(Nil);

db.DatabaseFolder := Self.DatabaseFolder;

db.Bank := Self.Bank;

db.Orphan := DestOrphan;

db.FStreamFirstBlockNumber := Start_Block;

end;

if db is TFileStorage then TFileStorage(db).LockBlockChainStream;

try

db.FIsMovingBlockchain:=True;

ops := TPCOperationsComp.Create(Nil);

try

b := Start_Block;

while LoadBlockChainBlock(ops,b) do begin

inc(b);

TLog.NewLog(ltDebug,Classname,'Moving block from "'+Orphan+'" to "'+DestOrphan+'" '+TPCOperationsComp.OperationBlockToText(ops.OperationBlock));

db.SaveBlockChainBlock(ops);

end;

TLog.NewLog(ltdebug,Classname,'Moved blockchain from "'+Orphan+'" to "'+DestOrphan+'" from block '+inttostr(Start_Block)+' to '+inttostr(b-1));

finally

ops.Free;

end;

// If DestOrphan is empty, then copy possible updated safebox (because, perhaps current saved safebox is from invalid blockchain)

if (DestOrphan='') And (Orphan<>'') then begin

DoCopySafebox;

end;

finally

db.FIsMovingBlockchain:=False;

if db is TFileStorage then TFileStorage(db).UnlockBlockChainStream;

end;

Finally

If Not Assigned(DestStorage) then db.Free;

End;

Except

On E:Exception do begin

TLog.NewLog(lterror,ClassName,'Error at DoMoveBlockChain: ('+E.ClassName+') '+E.Message);

Raise;

end;

End;

end;

function TFileStorage.DoRestoreBank(max_block: Int64; restoreProgressNotify : TProgressNotify): Boolean;

sr: TSearchRec;

FileAttrs: Integer;

folder : AnsiString;

Lfilename,auxfn : AnsiString;

fs : TFileStream;

ms : TMemoryStream;

errors : String;

LBlockscount : Cardinal;

sbHeader, goodSbHeader : TPCSafeBoxHeader;

{$IFDEF USE_ABSTRACTMEM}

LTempBlocksCount : Integer;

LSafeboxFileName : String;

{$ELSE}

{$ENDIF}

LockBlockChainStream;

Try

{$IFDEF USE_ABSTRACTMEM}

Lfilename := '';

LSafeboxFileName := GetFolder(Orphan)+PathDelim+'safebox'+CT_Safebox_Extension;

if TPCAbstractMem.AnalyzeFile(LSafeboxFileName,LTempBlocksCount) then begin

LBlockscount := LTempBlocksCount;

end else begin

LBlockscount := 0;

end;

//

FileAttrs := faArchive;

folder := GetFolder(''); /// Without Orphan folder

if SysUtils.FindFirst(folder+PathDelim+'checkpoint*'+CT_Safebox_Extension, FileAttrs, sr) = 0 then begin

repeat

if (sr.Attr and FileAttrs) = FileAttrs then begin

auxfn := folder+PathDelim+sr.Name;

if TPCAbstractMem.AnalyzeFile(auxfn,LTempBlocksCount) then begin

if (((max_block<0) Or (LTempBlocksCount<=max_block)) AND (LTempBlocksCount>LBlockscount)) then begin

Lfilename := auxfn;

LBlockscount := LTempBlocksCount;

end;

end;

end;

until FindNext(sr) <> 0;

FindClose(sr);

end;

if (Lfilename='') then begin

Bank.SafeBox.SetSafeboxFileName(LSafeboxFileName);

end else begin

Bank.SafeBox.SetSafeboxFileName(Lfilename);

Bank.SafeBox.UpdateSafeboxFileName(LSafeboxFileName);

end;

{$ELSE}

LBlockscount := 0;

{$ENDIF}

FileAttrs := faArchive;

folder := GetFolder(Orphan);

Lfilename := '';

if SysUtils.FindFirst(folder+PathDelim+'*.safebox', FileAttrs, sr) = 0 then begin

repeat

if (sr.Attr and FileAttrs) = FileAttrs then begin

auxfn := folder+PathDelim+sr.Name;

If LoadBankFileInfo(auxfn,sbHeader) then begin

if (((max_block<0) Or (sbHeader.endBlock<=max_block)) AND (sbHeader.blocksCount>LBlockscount)) And

(sbHeader.startBlock=0) And (sbHeader.endBlock=sbHeader.startBlock+sbHeader.blocksCount-1) then begin

Lfilename := auxfn;

LBlockscount := sbHeader.blocksCount;

goodSbHeader := sbHeader;

end;

end;

end;

until FindNext(sr) <> 0;

FindClose(sr);

end;

if (Lfilename<>'') then begin

TLog.NewLog(ltinfo,Self.ClassName,'Loading SafeBox protocol:'+IntToStr(goodSbHeader.protocol)+' with '+inttostr(LBlockscount)+' blocks from file '+Lfilename+' LowMemoryUsage:'+LowMemoryUsage.ToString(True));

fs := TFileStream.Create(Lfilename,fmOpenRead);

try

fs.Position := 0;

if LowMemoryUsage then begin

if not Bank.LoadBankFromStream(fs,False,Nil,Nil,restoreProgressNotify,errors) then begin

TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);

end;

end else begin

ms := TMemoryStream.Create;

Try

ms.CopyFrom(fs,0);

ms.Position := 0;

if not Bank.LoadBankFromStream(ms,False,Nil,Nil,restoreProgressNotify,errors) then begin

TLog.NewLog(lterror,ClassName,'Error reading bank from file: '+Lfilename+ ' Error: '+errors);

end;

Finally

ms.Free;

End;

end;

finally

fs.Free;

end;

end;

Finally

UnlockBlockChainStream;

End;

end;

function TFileStorage.DoSaveBank: Boolean;

var fs: TFileStream;

bankfilename,aux_newfilename: AnsiString;

ms : TMemoryStream;

LTC : TTickCount;

Result := true;

bankfilename := GetSafeboxCheckpointingFileName(GetFolder(Orphan),Bank.BlocksCount);

if (bankfilename<>'') then begin

LTC := TPlatform.GetTickCount;

{$IFDEF USE_ABSTRACTMEM}

Bank.SafeBox.SaveCheckpointing(bankfilename);

{$ELSE}

fs := TFileStream.Create(bankfilename,fmCreate);

try

fs.Size := 0;

fs.Position:=0;

if LowMemoryUsage then begin

Bank.SafeBox.SaveSafeBoxToAStream(fs,0,Bank.SafeBox.BlocksCount-1);

end else begin

ms := TMemoryStream.Create;

try

Bank.SafeBox.SaveSafeBoxToAStream(ms,0,Bank.SafeBox.BlocksCount-1);

ms.Position := 0;

fs.CopyFrom(ms,0);

finally

ms.Free;

end;

end;

finally

fs.Free;

end;

{$ENDIF}

TLog.NewLog(ltInfo,ClassName,Format('Saving Safebox blocks:%d file:%s in %.2n seconds',[Bank.BlocksCount,bankfilename,TPlatform.GetElapsedMilliseconds(LTC)/1000]));

// Save a copy each 10000 blocks (aprox 1 month) only when not an orphan

if (Orphan='') And ((Bank.BlocksCount MOD (CT_BankToDiskEveryNBlocks*100))=0) then begin

aux_newfilename := GetFolder('') + PathDelim+'checkpoint_'+ inttostr(Bank.BlocksCount)+CT_Safebox_Extension;

try

{$IFDEF FPC}

DoCopyFile(bankfilename,aux_newfilename);

{$ELSE}

CopyFile(PWideChar(bankfilename),PWideChar(aux_newfilename),False);

{$ENDIF}

Except

On E:Exception do begin

TLog.NewLog(lterror,ClassName,'Exception copying extra safebox file '+aux_newfilename+' ('+E.ClassName+'):'+E.Message);

end;

end;

end;

end;

end;

function TFileStorage.DoSaveBlockChain(Operations: TPCOperationsComp): Boolean;

Var stream : TStream;

iBlockHeaders : Integer;

BlockHeaderFirstBlock : Cardinal;

Result := False;

stream := LockBlockChainStream;

Try

if (Length(FBlockHeadersFirstBytePosition)=0) then begin

// Is saving first block on the stream?

if (Stream.Size=0) then begin

// Yes! Positioning

FStreamFirstBlockNumber := Operations.OperationBlock.block;

end;

TLog.NewLog(ltdebug,Classname,Format('Saving Block %d on a newer stream, stream first position=%d',[Operations.OperationBlock.block,FStreamFirstBlockNumber]));

end;

if Not GetBlockHeaderFirstBytePosition(stream,Operations.OperationBlock.block,True,iBlockHeaders,BlockHeaderFirstBlock) then exit;

Result := StreamBlockSave(stream,iBlockHeaders,BlockHeaderFirstBlock,Operations);

Finally

UnlockBlockChainStream;

End;

if Assigned(Bank) then SaveBank(False);

end;

Const CT_SafeboxsToStore = 10;

class function TFileStorage.GetSafeboxCheckpointingFileName(const BaseDataFolder: AnsiString; block: Cardinal): AnsiString;

Result := '';

If not ForceDirectories(BaseDataFolder) then exit;

if TPCSafeBox.MustSafeBoxBeSaved(block) then begin

// We will store checkpointing

Result := BaseDataFolder + PathDelim+'checkpoint'+ inttostr((block DIV CT_BankToDiskEveryNBlocks) MOD CT_SafeboxsToStore)+CT_Safebox_Extension;

end else begin

Result := BaseDataFolder + PathDelim+'checkpoint_'+inttostr(block)+CT_Safebox_Extension;

end;

end;

function TFileStorage.GetBlockHeaderFirstBytePosition(Stream : TStream; Block: Cardinal; CanInitialize : Boolean; var iBlockHeaders : Integer; var BlockHeaderFirstBlock: Cardinal): Boolean;

var iPos,start, nCurrBlock : Cardinal;

bh : TBlockHeader;

null_buff : Array[1..(CT_GroupBlockSize * CT_SizeOfBlockHeader)] of Byte;

Result := false;

if Block<FStreamFirstBlockNumber then begin

TLog.NewLog(lterror,Classname,Format('Block %d is lower than Stream First block %d',[Block,FStreamFirstBlockNumber]));

exit;

end;

iPos := (Block-FStreamFirstBlockNumber) DIV CT_GroupBlockSize;

if iPos>High(FBlockHeadersFirstBytePosition) then Begin

if Length(FBlockHeadersFirstBytePosition)>0 then begin

start := High(FBlockHeadersFirstBytePosition);

end else begin

If CanInitialize then begin

// Initialize and start at 0

SetLength(FBlockHeadersFirstBytePosition,1);

FBlockHeadersFirstBytePosition[0] := 0;

start := 0;

end else exit;

end;

while (start<iPos) do begin

// Read last start position

if (Stream.Size<(FBlockHeadersFirstBytePosition[start] + GetBlockHeaderFixedSize)) then begin

// This position not exists...

If (CanInitialize) then begin

GrowStreamUntilPos(Stream,FBlockHeadersFirstBytePosition[start],false);

// Save BlockHeader values (initialized to 0)

FillChar(null_buff,length(null_buff),0);

Stream.WriteBuffer(null_buff,length(null_buff));

end else begin

// This is a Fatal error due must find previos block!

TLog.NewLog(ltError,Classname,Format('Stream size %d is lower than BlockHeader[%d] position %d + BlockHeaderSize %d',

[Stream.size,start,FBlockHeadersFirstBytePosition[start],GetBlockHeaderFixedSize]));

exit;

end;

end;

Stream.Position := FBlockHeadersFirstBytePosition[start] + GetBlockHeaderFixedSize - CT_SizeOfBlockHeader;

// Read last saved Header

nCurrBlock := FStreamFirstBlockNumber + ((start+1) * CT_GroupBlockSize) - 1;

Repeat

Stream.Read(bh.BlockNumber,SizeOf(bh.BlockNumber));

Stream.Read(bh.StreamBlockRelStartPos,SizeOf(bh.StreamBlockRelStartPos));

Stream.Read(bh.BlockSize,sizeof(bh.BlockSize));

If (bh.BlockNumber<>nCurrBlock) then begin

if (bh.BlockNumber<>0) Or (bh.StreamBlockRelStartPos<>0) Or (bh.BlockSize<>0) then begin

TLog.NewLog(ltError,ClassName,Format('Fatal error. Found a Tblockheader with no 0 values searching for block:%d at nCurrBlock:%d - Number:%d RelStartPos:%d Size:%d',[block,nCurrBlock,bh.BlockNumber,bh.StreamBlockRelStartPos,bh.BlockSize]));

exit;

end;

if ((start=0) And (nCurrBlock>FStreamFirstBlockNumber))

Or

((start>0) And (nCurrBlock>(FStreamFirstBlockNumber + ((start) * CT_GroupBlockSize)))) then begin

dec(nCurrBlock);

// Positioning for new read:

Stream.Seek(Int64(CT_SizeOfBlockHeader)*(-2),soFromCurrent);

end else begin

break; // End of blockheader!

end;

end;

until (bh.BlockNumber>0);

// Positioning!

Stream.Position := FBlockHeadersFirstBytePosition[start] + GetBlockHeaderFixedSize;

//

SetLength(FBlockHeadersFirstBytePosition,length(FBlockHeadersFirstBytePosition)+1);

if bh.BlockNumber>0 then begin

FBlockHeadersFirstBytePosition[High(FBlockHeadersFirstBytePosition)] := Stream.Position + bh.StreamBlockRelStartPos + bh.BlockSize;

end else begin

// Not found a block, starting at last pos

FBlockHeadersFirstBytePosition[High(FBlockHeadersFirstBytePosition)] := Stream.Position;

end;

inc(start);

// Check if blockheader size is ok:

if (CanInitialize) And (Stream.Size<(FBlockHeadersFirstBytePosition[start] + GetBlockHeaderFixedSize)) then begin

Stream.Position := FBlockHeadersFirstBytePosition[start];

TLog.NewLog(ltInfo,ClassName,Format('Increasing size for blockheader %d at pos:%d (current stream pos %d size %d) to position:%d',

[start,FBlockHeadersFirstBytePosition[start],Stream.Position,Stream.Size,

FBlockHeadersFirstBytePosition[start]+GetBlockHeaderFixedSize]));

GrowStreamUntilPos(Stream,FBlockHeadersFirstBytePosition[start]+GetBlockHeaderFixedSize,true);

end;

end;

End;

iBlockHeaders := iPos;

BlockHeaderFirstBlock := FStreamFirstBlockNumber + (iPos * CT_GroupBlockSize);

Result := true;

end;

function TFileStorage.GetBlockHeaderFixedSize: Int64;

Result := (CT_GroupBlockSize* CT_SizeOfBlockHeader);

end;

function TFileStorage.GetFirstBlockNumber: Int64;

Result := FStreamFirstBlockNumber;

end;

function TFileStorage.GetFolder(const AOrphan: TOrphan): AnsiString;

if FDatabaseFolder = '' then raise Exception.Create('No Database Folder');

if AOrphan<>'' then Result := FDatabaseFolder + PathDelim+AOrphan

else Result := FDatabaseFolder;

if not ForceDirectories(Result) then raise Exception.Create('Cannot create database folder: '+Result);

end;

function TFileStorage.GetLastBlockNumber: Int64;

Result := FStreamLastBlockNumber;

end;

function TFileStorage.LoadBankFileInfo(const Filename: AnsiString; var safeBoxHeader : TPCSafeBoxHeader) : Boolean;

var fs: TFileStream;

Result := false;

safeBoxHeader := CT_PCSafeBoxHeader_NUL;

If Not FileExists(Filename) then exit;

fs := TFileStream.Create(Filename,fmOpenRead);

try

fs.Position:=0;

Result := Bank.SafeBox.LoadSafeBoxStreamHeader(fs,safeBoxHeader);

finally

fs.Free;

end;

end;

function TFileStorage.LockBlockChainStream: TFileStream;

function InitStreamInfo(Stream : TStream; var errors : String) : Boolean;

Var mem : TStream;

iPos : Int64;

i,j,k : Integer;

bh,lastbh : TBlockHeader;

begin

errors := '';

FStreamFirstBlockNumber := 0;

FStreamLastBlockNumber := -1;

SetLength(FBlockHeadersFirstBytePosition,0);

Result := False;

//

if stream.Size<GetBlockHeaderFixedSize then begin

if (stream.Size=0) then begin

Result := true;

exit;

end else begin

// Invalid stream!

if (ReadOnly) then begin

errors := Format('Invalid stream size %d. Lower than minimum %d',[stream.Size, GetBlockHeaderFixedSize]);

exit;

end else begin

// Clear it

TLog.NewLog(ltError,ClassName,Format('Invalid stream size %d. Lower than minimum %d - Initialized to 0',[stream.Size, GetBlockHeaderFixedSize]));

stream.size := 0;

Result := True;

Exit;

end;

end;

end;

// Initialize it

if stream.Size>GetBlockHeaderFixedSize then begin

SetLength(FBlockHeadersFirstBytePosition,1);

FBlockHeadersFirstBytePosition[0] := 0;

end;

mem := TMemoryStream.Create;

Try

iPos := 0;

while (iPos + GetBlockHeaderFixedSize < Stream.Size) do begin

Stream.Position := iPos;

mem.Size := 0;

mem.CopyFrom(Stream,GetBlockHeaderFixedSize);

// Analize it:

mem.Position := 0;

for i := 0 to CT_GroupBlockSize-1 do begin

mem.Read(bh.BlockNumber,SizeOf(bh.BlockNumber));

mem.Read(bh.StreamBlockRelStartPos,SizeOf(bh.StreamBlockRelStartPos));

mem.Read(bh.BlockSize,sizeof(bh.BlockSize));

if (i=0) And (iPos=0) then begin

FStreamFirstBlockNumber := bh.BlockNumber;

FStreamLastBlockNumber := bh.BlockNumber;

if (0<>bh.StreamBlockRelStartPos) then begin

errors := Format('Invalid BlockChain stream. First block start rel pos %d',[bh.StreamBlockRelStartPos]);

if (ReadOnly) then begin

Exit;

end else begin

FStreamFirstBlockNumber := 0;

FStreamLastBlockNumber := -1;

SetLength(FBlockHeadersFirstBytePosition,0);

stream.Size:=0; // Set size to 0, no data

TLog.NewLog(ltError,ClassName,Format('%s - Initialized to 0',[errors]));

Result := True;

end;

Exit;

end;

lastbh := bh;

end else begin

// Protocol 2: We can find blocks not saved, with all values to 0

if (bh.BlockNumber=0) then begin

// This is an "empty" block. Check that ok

If (bh.BlockNumber<>0) Or (bh.StreamBlockRelStartPos<>0) Or (bh.BlockSize<>0) then begin

errors := Format('Invalid BlockChain stream not empty block on block header. iPos=%d i=%d BlockNumber=%d relstart=%d size=%d - Last block:%d BlockNumber=%d relstart=%d size=%d',

[iPos,i,bh.BlockNumber,bh.StreamBlockRelStartPos,bh.BlockSize,

FStreamLastBlockNumber,

lastbh.BlockNumber,lastbh.StreamBlockRelStartPos,lastbh.BlockSize]);

if (ReadOnly) then begin

Exit;

end else begin

TLog.NewLog(lterror,ClassName,Format('%s - Initialized to %d',[errors,FStreamFirstBlockNumber]));

DoDeleteBlockChainBlocks(FStreamLastBlockNumber+1);

Result := True;

Exit;

end;

end;

// Ok, inc blocknumber

inc(lastbh.BlockNumber);

end else begin

if (lastbh.BlockNumber+1<>bh.BlockNumber) or

((lastbh.StreamBlockRelStartPos+lastbh.BlockSize<>bh.StreamBlockRelStartPos) And (i>0)) Or

((0<>bh.StreamBlockRelStartPos) And (i=0)) then begin

errors := Format('Invalid BlockChain stream on block header. iPos=%d i=%d BlockNumber=%d relstart=%d size=%d - Last block:%d BlockNumber=%d relstart=%d size=%d',

[iPos,i,bh.BlockNumber,bh.StreamBlockRelStartPos,bh.BlockSize,FStreamLastBlockNumber,

lastbh.BlockNumber,lastbh.StreamBlockRelStartPos,lastbh.BlockSize]);

If (ReadOnly) then begin

Exit;

end else begin

TLog.NewLog(lterror,ClassName,Format('%s - Initialized to %d',[errors,FStreamFirstBlockNumber]));

DoDeleteBlockChainBlocks(FStreamLastBlockNumber+1);

Result := True;

Exit;

end;

end else begin

FStreamLastBlockNumber := bh.BlockNumber;

lastbh := bh;

end;

end;

end;

end;

iPos := iPos + GetBlockHeaderFixedSize + lastbh.StreamBlockRelStartPos + lastBh.BlockSize;

lastbh.StreamBlockRelStartPos:=0;

lastbh.BlockSize:=0;

end;

Result := True;

Finally

mem.Free;

End;

end;

Var fn : TFileName;

fm : Word;

exists : Boolean;

bh : TBlockHeader;

errors : String;

TPCThread.ProtectEnterCriticalSection(Self,FStorageLock);

Try

if Not Assigned(FBlockChainStream) then begin

if FBlockChainFileName<>'' then begin

fn := FBlockChainFileName

end else begin

fn := GetFolder(Orphan)+PathDelim+'BlockChainStream.blocks';

end;

exists := FileExists(fn);

if ReadOnly then begin

if exists then fm := fmOpenRead+fmShareDenyNone

else raise Exception.Create('FileStorage not exists for open ReadOnly: '+fn);

end else begin

if exists then fm := fmOpenReadWrite+fmShareDenyWrite

else fm := fmCreate+fmShareDenyWrite

end;

FBlockChainStream := TFileStream.Create(fn,fm);

// Init stream

If Not InitStreamInfo(FBlockChainStream,errors) then begin

TLog.NewLog(lterror,ClassName,errors);

raise Exception.Create('Error reading File: '+fn+#10+'Errors:'+#10+errors);

end else begin

TLog.NewLog(ltInfo,ClassName,Format('Loaded blockchain file: %s with blocks from %d to %d',[fn,FStreamFirstBlockNumber,FStreamLastBlockNumber]));

end;

end;

Except

FStorageLock.Release;

Raise;

End;

Result := FBlockChainStream;

end;

procedure TFileStorage.SetBlockChainFile(BlockChainFileName: AnsiString);

ClearStream;

FBlockChainFileName := BlockChainFileName;

end;

procedure TFileStorage.SetDatabaseFolder(const Value: AnsiString);

if FDatabaseFolder=Value then exit;

FDatabaseFolder := Value;

ClearStream;

end;

procedure TFileStorage.SetOrphan(const Value: TOrphan);

inherited;

ClearStream;

end;

procedure TFileStorage.SetReadOnly(const Value: Boolean);

inherited;

ClearStream;

end;

function TFileStorage.StreamBlockRead(Stream : TStream; iBlockHeaders : Integer; BlockHeaderFirstBlock, Block : Cardinal; Operations : TPCOperationsComp) : Boolean;

Var p : Int64;

errors : String;

streamFirstBlock,

_BlockSizeC,

_intBlockIndex : Cardinal;

_Header : TBlockHeader;

_ops : TStream;

_StreamBlockHeaderStartPos : Int64;

Result := False;

If Not StreamReadBlockHeader(Stream,iBlockHeaders,BlockHeaderFirstBlock,Block,False,_Header) then exit;

// Calculating block position

_StreamBlockHeaderStartPos:=FBlockHeadersFirstBytePosition[iBlockHeaders];

p := (_StreamBlockHeaderStartPos + GetBlockHeaderFixedSize) +

(_Header.StreamBlockRelStartPos);

if Stream.Size<(p + _Header.BlockSize) then begin

TLog.NewLog(ltError,Classname,Format(

'Invalid stream size. Block %d need to be at relative %d after %d = %d BlockSize:%d (Size %d)',

[Block,_Header.StreamBlockRelStartPos,(_StreamBlockHeaderStartPos + GetBlockHeaderFixedSize),p,_Header.BlockSize,Stream.Size]));

exit;

end;

Stream.Position := p;

// Read the block

// Reading size

Stream.Read(_BlockSizeC,sizeof(_BlockSizeC));

if ((_BlockSizeC+sizeof(_BlockSizeC))>(_Header.BlockSize)) then begin

TLog.NewLog(lterror,Classname,Format('Corruption at stream Block size. Block %d SizeH:%d SizeC:%d',[Block,

_Header.BlockSize,_BlockSizeC]));

exit;

end;

// Reading Block

_ops := TMemoryStream.Create;

try

_ops.CopyFrom(Stream,_BlockSizeC);

_ops.Position := 0;

If Not Operations.LoadBlockFromStorage(_ops,errors) then begin