Merge upstream

src/core/UFileStorage.pas

@@ -235,11 +235,16 @@ begin
     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
@@ -683,6 +688,7 @@ function TFileStorage.LockBlockChainStream: TFileStream;
     FStreamFirstBlockNumber := 0;
     FStreamLastBlockNumber := -1;
     SetLength(FBlockHeadersFirstBytePosition,0);
+    Result := False;
     //
     if stream.Size<GetBlockHeaderFixedSize then begin
       if (stream.Size=0) then begin
@@ -690,9 +696,16 @@ function TFileStorage.LockBlockChainStream: TFileStream;
         exit;
       end else begin
         // Invalid stream!
-        Result := false;
-        errors := Format('Invalid stream size %d. Lower than minimum %d',[stream.Size, GetBlockHeaderFixedSize]);
-        exit;
+        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
@@ -717,9 +730,18 @@ function TFileStorage.LockBlockChainStream: TFileStream;
             FStreamFirstBlockNumber := bh.BlockNumber;
             FStreamLastBlockNumber := bh.BlockNumber;
             if (0<>bh.StreamBlockRelStartPos) then begin
-              errors := Format('Invalid first block start rel pos %d',[bh.StreamBlockRelStartPos]);
-              result := false;
-              exit;
+              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
@@ -727,12 +749,18 @@ function TFileStorage.LockBlockChainStream: TFileStream;
             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 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]);
-                result := false;
-                exit;
+                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);
@@ -740,11 +768,17 @@ function TFileStorage.LockBlockChainStream: TFileStream;
               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 check on block header. iPos=%d i=%d BlockNumber=%d relstart=%d size=%d - Last block:%d BlockNumber=%d relstart=%d size=%d',
+                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]);
-                result := false;
-                exit;
+                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;
@@ -756,7 +790,7 @@ function TFileStorage.LockBlockChainStream: TFileStream;
         lastbh.StreamBlockRelStartPos:=0;
         lastbh.BlockSize:=0;
       end;
-      Result := true;
+      Result := True;
     Finally
       mem.Free;
     End;
@@ -789,6 +823,8 @@ begin
       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
@@ -917,6 +953,8 @@ begin
     Stream.Write(c,sizeof(_Header.BlockSize));
     // Positioning until Header end
     GrowStreamUntilPos(Stream,_StreamBlockHeaderStartPos + GetBlockHeaderFixedSize,true);
+    // If this is an override, 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)
     // And now positioning until Data:
     GrowStreamUntilPos(Stream,_StreamBlockHeaderStartPos + GetBlockHeaderFixedSize + _Header.StreamBlockRelStartPos, false );
     {$IFDEF HIGHLOG}

src/core/UPoolMining.pas

@@ -164,7 +164,7 @@ Const
 
 implementation
 
-Uses ULog, Variants, UTime, UNetProtocol;
+Uses ULog, Variants, UTime, UNetProtocol, UBaseTypes;
 
 Type TPendingResponseMessage = Record
        sendDateTime : TDateTime;
@@ -222,7 +222,7 @@ end;
 function TJSONRPCTcpIpClient.DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean; var ResponseMethod : String; var jsonObject : TPCJSONObject) : Boolean;
 var last_bytes_read : Integer;
   jsonData : TPCJSONData;
-  tc : Cardinal;
+  tc : TTickCount;
   ms : TMemoryStream;
   i,lasti : Integer;
   continue : Boolean;
@@ -286,15 +286,15 @@ var islocked : Boolean;
 begin
   Result := false;
   ResponseMethod := '';
-  tc := GetTickCount;
+  tc := TPlatform.GetTickCount;
   Repeat
     islocked := FLockProcessBuffer.TryEnter;
-  until (islocked) Or ((GetTickCount>(tc+MaxWaitMiliseconds)) And (MaxWaitMiliseconds<>0));
+  until (islocked) Or ((TPlatform.GetTickCount>(tc+MaxWaitMiliseconds)) And (MaxWaitMiliseconds<>0));
   If Not islocked then exit;
   try
     if Assigned(SenderThread) then continue := Not SenderThread.Terminated
     else continue := true;
-    while (Connected) And ((GetTickCount<=(tc+MaxWaitMiliseconds)) Or (MaxWaitMiliseconds=0)) And (continue) do begin
+    while (Connected) And ((TPlatform.GetTickCount<=(tc+MaxWaitMiliseconds)) Or (MaxWaitMiliseconds=0)) And (continue) do begin
       last_bytes_read := 0;
       ms := ReadBufferLock;
       try
@@ -432,7 +432,8 @@ end;
 
 function TJSONRPCTcpIpClient.SendJSONRPCMethodAndWait(const method: String; params: TPCJSONList; MaxWaitMiliseconds: Cardinal; resultObject : TPCJSONObject; processEventOnInvalid : TProcessJSONObjectEvent = Nil) : Boolean;
 Var nId : Cardinal;
-  tc,maxw : Cardinal;
+  tc : TTickCount;
+  maxw : Cardinal;
   json : TPCJSONObject;
   rm : String;
 begin
@@ -441,11 +442,11 @@ begin
   try
     nId := GetNewId;
     SendJSONRPCMethod(method,params,nId);
-    tc := GetTickCount;
+    tc := TPlatform.GetTickCount;
     json := TPCJSONObject.Create;
     Try
       repeat
-        maxw := MaxWaitMiliseconds - (GetTickCount - tc);
+        maxw := MaxWaitMiliseconds - (TPlatform.GetTickCount - tc);
         if maxw<1 then maxw := 1
         else if maxw>10000 then maxw := 10000;
         If DoProcessBuffer(nil,maxw,true,rm,json) then begin
@@ -460,7 +461,7 @@ begin
             end else TLog.NewLog(lterror,Classname,'Lost JSON message! '+json.ToJSON(false));
           end;
         end;
-      until (Result) Or (GetTickCount > (tc+MaxWaitMiliseconds));
+      until (Result) Or (TPlatform.GetTickCount > (tc+MaxWaitMiliseconds));
     finally
       json.free;
     end;
@@ -877,7 +878,7 @@ begin
     inc(FIncomingsCounter);
     SendJobToMiner(nil,bClient,false,null);
     while (Active) And (Client.Connected) do begin
-      doDelete := bClient.LastReadTC+1000<GetTickCount;  // TODO: Protect GetTickCount overflow
+      doDelete := bClient.LastReadTC+1000<TPlatform.GetTickCount;  // TODO: Protect GetTickCount overflow
       jsonobj := TPCJSONObject.Create;
       try
         if bClient.DoProcessBuffer(nil,1000,doDelete,rmethod,jsonobj) then begin

src/core/URPC.pas

@@ -21,7 +21,7 @@ interface
 
 Uses UThread, ULog, UConst, UNode, UAccounts, UCrypto, UBlockChain,
   UNetProtocol, UOpTransaction, UWallet, UTime, UAES, UECIES, UTxMultiOperation,
-  UJSONFunctions, classes, blcksock, synsock, IniFiles, Variants, math;
+  UJSONFunctions, classes, blcksock, synsock, IniFiles, Variants, math, UBaseTypes;
 
 Const
   CT_RPC_ErrNum_InternalError = 100;
@@ -511,11 +511,11 @@ var
   valid : Boolean;
   i : Integer;
   Headers : TStringList;
-  tc : Cardinal;
+  tc : TTickCount;
   callcounter : Int64;
 begin
   callcounter := _RPCServer.GetNewCallCounter;
-  tc := GetTickCount;
+  tc := TPlatform.GetTickCount;
   methodName := '';
   paramsTxt := '';
   // IP Protection
@@ -647,7 +647,7 @@ begin
           FSock.SendBuffer(addr(jsonresponsetxt[1]),Length(jsonresponsetxt));
         end;
       end;
-      _RPCServer.AddRPCLog(FSock.GetRemoteSinIP+':'+InttoStr(FSock.GetRemoteSinPort),'Method:'+methodName+' Params:'+paramsTxt+' '+Inttostr(errNum)+':'+errDesc+' Time:'+FormatFloat('0.000',(GetTickCount - tc)/1000));
+      _RPCServer.AddRPCLog(FSock.GetRemoteSinIP+':'+InttoStr(FSock.GetRemoteSinPort),'Method:'+methodName+' Params:'+paramsTxt+' '+Inttostr(errNum)+':'+errDesc+' Time:'+FormatFloat('0.000',(TPlatform.GetTickCount - tc)/1000));
     finally
       jsonresponse.free;
       Headers.Free;

src/core/UTCPIP.pas

@@ -35,7 +35,7 @@ uses
   {$IFDEF DelphiSockets}
   Sockets,
   {$ENDIF}
-  Classes, Sysutils,
+  Classes, Sysutils, UBaseTypes,
   UThread, SyncObjs;
 
 type
@@ -113,7 +113,7 @@ type
     FSendBuffer : TMemoryStream;
     FReadBuffer : TMemoryStream;
     FCritical : TPCCriticalSection;
-    FLastReadTC : Cardinal;
+    FLastReadTC : TTickCount;
     FBufferedNetTcpIpClientThread : TBufferedNetTcpIpClientThread;
   protected
     Function DoWaitForDataInherited(WaitMilliseconds : Integer) : Boolean;
@@ -124,7 +124,7 @@ type
     Procedure WriteBufferToSend(SendData : TStream);
     Function ReadBufferLock : TMemoryStream;
     Procedure ReadBufferUnlock;
-    Property LastReadTC : Cardinal read FLastReadTC;
+    Property LastReadTC : TTickCount read FLastReadTC;
   End;
 
   {$IFDEF Synapse}
@@ -562,7 +562,7 @@ var SendBuffStream : TStream;
         if (last_bytes_read>0) then begin
           ms := FBufferedNetTcpIpClient.ReadBufferLock;
           Try
-            FBufferedNetTcpIpClient.FLastReadTC := GetTickCount;
+            FBufferedNetTcpIpClient.FLastReadTC := TPlatform.GetTickCount;
             lastpos := ms.Position;
             ms.Position := ms.Size;
             ms.Write(ReceiveBuffer,last_bytes_read);
@@ -608,7 +608,7 @@ begin
         If (Not Terminated) And (FBufferedNetTcpIpClient.Connected) then DoReceiveBuf;
         // Send Data
         If (Not Terminated) And (FBufferedNetTcpIpClient.Connected) then DoSendBuf;
-      end else FBufferedNetTcpIpClient.FLastReadTC := GetTickCount;
+      end else FBufferedNetTcpIpClient.FLastReadTC := TPlatform.GetTickCount;
       // Sleep
       Sleep(10); // Slepp 10 is better than sleep 1
     end;
@@ -629,7 +629,7 @@ end;
 constructor TBufferedNetTcpIpClient.Create(AOwner: TComponent);
 begin
   inherited;
-  FLastReadTC := GetTickCount;
+  FLastReadTC := TPlatform.GetTickCount;
   FCritical := TPCCriticalSection.Create('TBufferedNetTcpIpClient_Critical');
   FSendBuffer := TMemoryStream.Create;
   FReadBuffer := TMemoryStream.Create;

src/core/UThread.pas

@@ -349,9 +349,9 @@ end;
 {$IFDEF HIGHLOG}
 procedure TPCCriticalSection.Acquire;
 Var continue, logged : Boolean;
-  startTC : Cardinal;
+  startTC : TTickCount;
 begin
-  startTC := GetTickCount;
+  startTC := TPlatform.GetTickCount;
   FCounterLock.Acquire;
   try
     FWaitingForCounter := FWaitingForCounter + 1;
@@ -362,18 +362,18 @@ begin
   Repeat
     continue := inherited TryEnter;
     if (Not continue) then begin
-      If (not logged) And ((FStartedTimestamp>0) And ((FStartedTimestamp+1000)<GetTickCount)) then begin
+      If (not logged) And ((FStartedTimestamp>0) And ((FStartedTimestamp+1000)<TPlatform.GetTickCount)) then begin
         logged := true;
         TLog.NewLog(ltdebug,ClassName,'ALERT Critical section '+IntToHex(PtrInt(Self),8)+' '+Name+
           ' locked by '+IntToHex(FCurrentThread,8)+' waiting '+
-          IntToStr(FWaitingForCounter)+' elapsed milis: '+IntToStr(GetTickCount-FStartedTimestamp) );
+          IntToStr(FWaitingForCounter)+' elapsed milis: '+IntToStr(TPlatform.GetTickCount-FStartedTimestamp) );
         continue := true;
         inherited;
       end else sleep(1);
     end;
   Until continue;
   if (logged) then begin
-    TLog.NewLog(ltdebug,Classname,'ENTER Critical section '+IntToHex(PtrInt(Self),8)+' '+Name+' elapsed milis: '+IntToStr(GetTickCount - startTC) );
+    TLog.NewLog(ltdebug,Classname,'ENTER Critical section '+IntToHex(PtrInt(Self),8)+' '+Name+' elapsed milis: '+IntToStr(TPlatform.GetTickCount - startTC) );
   end;
   FCounterLock.Acquire;
   try
@@ -382,7 +382,7 @@ begin
     FCounterLock.Release;
   end;
   FCurrentThread := TThread.CurrentThread.ThreadID;
-  FStartedTimestamp := GetTickCount;
+  FStartedTimestamp := TPlatform.GetTickCount;
   inherited;
 end;
 {$ENDIF}
@@ -422,7 +422,7 @@ begin
   end;
   If inherited TryEnter then begin
     FCurrentThread := TThread.CurrentThread.ThreadID;
-    FStartedTimestamp := GetTickCount;
+    FStartedTimestamp := TPlatform.GetTickCount;
     Result := true;
   end else Result := false;
   FCounterLock.Acquire;