|
@@ -26,7 +26,7 @@ Uses
|
|
{LCLIntf, LCLType, LMessages,}
|
|
{LCLIntf, LCLType, LMessages,}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
UTCPIP, SysUtils, UThread, SyncObjs, Classes, UJSONFunctions, UAES, UNode,
|
|
UTCPIP, SysUtils, UThread, SyncObjs, Classes, UJSONFunctions, UAES, UNode,
|
|
- UCrypto, UAccounts;
|
|
|
|
|
|
+ UCrypto, UAccounts, UConst;
|
|
|
|
|
|
Const
|
|
Const
|
|
CT_PoolMining_Method_STATUS = 'status';
|
|
CT_PoolMining_Method_STATUS = 'status';
|
|
@@ -45,12 +45,15 @@ Type
|
|
target_pow : TRawBytes;
|
|
target_pow : TRawBytes;
|
|
End;
|
|
End;
|
|
|
|
|
|
|
|
+ TProcessJSONObjectEvent = Procedure (json : TPCJSONObject; method : String) of object;
|
|
|
|
+
|
|
TJSONRPCTcpIpClient = Class(TBufferedNetTcpIpClient)
|
|
TJSONRPCTcpIpClient = Class(TBufferedNetTcpIpClient)
|
|
private
|
|
private
|
|
- FWaitingForResponseId : Cardinal;
|
|
|
|
- FMaxWaitingForResponseMiliseconds : Cardinal;
|
|
|
|
FLastId : Cardinal;
|
|
FLastId : Cardinal;
|
|
|
|
+ FLockProcessBuffer : TCriticalSection;
|
|
FReceivedBuffer : TBytes;
|
|
FReceivedBuffer : TBytes;
|
|
|
|
+ FLockReceivedBuffer : TCriticalSection;
|
|
|
|
+ FPendingResponseMessages : TPCThreadList;
|
|
protected
|
|
protected
|
|
public
|
|
public
|
|
Constructor Create(AOwner : TComponent); override;
|
|
Constructor Create(AOwner : TComponent); override;
|
|
@@ -58,8 +61,8 @@ Type
|
|
Procedure SendJSONRPCErrorResponse(const id : Variant; const error : String);
|
|
Procedure SendJSONRPCErrorResponse(const id : Variant; const error : String);
|
|
Procedure SendJSONRPCResponse(result : TPCJSONObject; const id : Variant);
|
|
Procedure SendJSONRPCResponse(result : TPCJSONObject; const id : Variant);
|
|
Procedure SendJSONRPCMethod(const method : String; params : TPCJSONObject; const id : Variant);
|
|
Procedure SendJSONRPCMethod(const method : String; params : TPCJSONObject; const id : Variant);
|
|
- Function SendJSONRPCMethodAndWait(const method : String; params : TPCJSONObject; MaxWaitMiliseconds : Cardinal; resultObject : TPCJSONObject) : Boolean;
|
|
|
|
- Function DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean) : TPCJSONObject;
|
|
|
|
|
|
+ Function SendJSONRPCMethodAndWait(const method : String; params : TPCJSONObject; MaxWaitMiliseconds : Cardinal; resultObject : TPCJSONObject; processEventOnInvalid : TProcessJSONObjectEvent = Nil) : Boolean;
|
|
|
|
+ Function DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean; var ResponseMethod : String; var jsonObject : TPCJSONObject) : Boolean;
|
|
Function GetNewId : Cardinal;
|
|
Function GetNewId : Cardinal;
|
|
End;
|
|
End;
|
|
|
|
|
|
@@ -74,7 +77,7 @@ Type
|
|
Property OnMinerMustChangeValues : TNotifyEvent read FOnMinerMustChangeValues write FOnMinerMustChangeValues;
|
|
Property OnMinerMustChangeValues : TNotifyEvent read FOnMinerMustChangeValues write FOnMinerMustChangeValues;
|
|
Property MinerValuesForWork : TMinerValuesForWork read FMinerValuesForWork write SetMinerValuesForWork;
|
|
Property MinerValuesForWork : TMinerValuesForWork read FMinerValuesForWork write SetMinerValuesForWork;
|
|
Procedure SubmitBlockFound(Const Payload : TRawBytes; Timestamp, NOnce : Cardinal);
|
|
Procedure SubmitBlockFound(Const Payload : TRawBytes; Timestamp, NOnce : Cardinal);
|
|
- Procedure DoProcessJSONObject(json : TPCJSONObject);
|
|
|
|
|
|
+ Procedure DoProcessJSONObject(json : TPCJSONObject; ResponseMethod : String);
|
|
End;
|
|
End;
|
|
|
|
|
|
TPoolMiningServer = Class(TNetTcpIpServer)
|
|
TPoolMiningServer = Class(TNetTcpIpServer)
|
|
@@ -85,7 +88,8 @@ Type
|
|
FMinerPayload: TRawBytes;
|
|
FMinerPayload: TRawBytes;
|
|
FClientsWins: Integer;
|
|
FClientsWins: Integer;
|
|
FClientsCount: Integer;
|
|
FClientsCount: Integer;
|
|
- Procedure DoProcessJSON(json : TPCJSONObject; Client : TJSONRPCTcpIpClient);
|
|
|
|
|
|
+ FOnMiningServerNewBlockFound: TNotifyEvent;
|
|
|
|
+ Procedure DoProcessJSON(json : TPCJSONObject; ResponseMethod : String; Client : TJSONRPCTcpIpClient);
|
|
Procedure OnNodeNewBlock(Sender : TObject);
|
|
Procedure OnNodeNewBlock(Sender : TObject);
|
|
Procedure OnNodeOperationsChanged(Sender : TObject);
|
|
Procedure OnNodeOperationsChanged(Sender : TObject);
|
|
Procedure Send_mine_values_to_all;
|
|
Procedure Send_mine_values_to_all;
|
|
@@ -104,8 +108,11 @@ Type
|
|
Procedure UpdateAccountAndPayload(AMinerAccountKey : TAccountKey; AMinerPayload : TRawBytes);
|
|
Procedure UpdateAccountAndPayload(AMinerAccountKey : TAccountKey; AMinerPayload : TRawBytes);
|
|
Property ClientsCount : Integer read FClientsCount;
|
|
Property ClientsCount : Integer read FClientsCount;
|
|
Property ClientsWins : Integer read FClientsWins;
|
|
Property ClientsWins : Integer read FClientsWins;
|
|
|
|
+ Property OnMiningServerNewBlockFound : TNotifyEvent read FOnMiningServerNewBlockFound write FOnMiningServerNewBlockFound;
|
|
End;
|
|
End;
|
|
|
|
|
|
|
|
+Function TBytesToString(Const bytes : TBytes):AnsiString;
|
|
|
|
+
|
|
Const
|
|
Const
|
|
CT_TMinerValuesForWork_NULL : TMinerValuesForWork = (block:0;version:0;part1:'';payload_start:'';part3:'';target:0;timestamp:0;target_pow:'');
|
|
CT_TMinerValuesForWork_NULL : TMinerValuesForWork = (block:0;version:0;part1:'';payload_start:'';part3:'';target:0;timestamp:0;target_pow:'');
|
|
|
|
|
|
@@ -113,82 +120,191 @@ implementation
|
|
|
|
|
|
Uses ULog, Variants, UTime, UBlockChain;
|
|
Uses ULog, Variants, UTime, UBlockChain;
|
|
|
|
|
|
|
|
+Type TPendingResponseMessage = Record
|
|
|
|
+ sendDateTime : TDateTime;
|
|
|
|
+ maxDateTime : TDateTime;
|
|
|
|
+ id : Integer;
|
|
|
|
+ method : String;
|
|
|
|
+ end;
|
|
|
|
+ PPendingResponseMessage = ^TPendingResponseMessage;
|
|
|
|
+
|
|
|
|
+Function TBytesToString(Const bytes : TBytes):AnsiString;
|
|
|
|
+Var i : Integer;
|
|
|
|
+Begin
|
|
|
|
+ Result := '';
|
|
|
|
+ for i := 0 to high(bytes) do begin
|
|
|
|
+ if (bytes[i]<32) then Result := Result+'#'+IntToHex(bytes[i],2)
|
|
|
|
+ else if bytes[i]=ord('#') then Result := Result+'##'
|
|
|
|
+ else Result := Result + ansichar(bytes[i]);
|
|
|
|
+ end;
|
|
|
|
+End;
|
|
|
|
+
|
|
{ TJSONRPCTcpIpClient }
|
|
{ TJSONRPCTcpIpClient }
|
|
|
|
|
|
constructor TJSONRPCTcpIpClient.Create(AOwner: TComponent);
|
|
constructor TJSONRPCTcpIpClient.Create(AOwner: TComponent);
|
|
begin
|
|
begin
|
|
inherited;
|
|
inherited;
|
|
FLastId := 1;
|
|
FLastId := 1;
|
|
- FWaitingForResponseId := 0;
|
|
|
|
- FMaxWaitingForResponseMiliseconds := 0;
|
|
|
|
SetLength(FReceivedBuffer,0);
|
|
SetLength(FReceivedBuffer,0);
|
|
|
|
+ FLockProcessBuffer := TCriticalSection.Create;
|
|
|
|
+ FLockReceivedBuffer := TCriticalSection.Create;
|
|
|
|
+ FPendingResponseMessages := TPCThreadList.Create;
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor TJSONRPCTcpIpClient.Destroy;
|
|
destructor TJSONRPCTcpIpClient.Destroy;
|
|
|
|
+var P : PPendingResponseMessage;
|
|
|
|
+ l : TList;
|
|
|
|
+ i : Integer;
|
|
begin
|
|
begin
|
|
|
|
+ l := FPendingResponseMessages.LockList;
|
|
|
|
+ try
|
|
|
|
+ for i:=0 to l.count-1 do begin
|
|
|
|
+ P:=l[i];
|
|
|
|
+ Dispose(P);
|
|
|
|
+ end;
|
|
|
|
+ l.clear;
|
|
|
|
+ finally
|
|
|
|
+ FPendingResponseMessages.UnlockList;
|
|
|
|
+ end;
|
|
|
|
+ FreeAndNil(FLockReceivedBuffer);
|
|
|
|
+ FreeAndNil(FLockProcessBuffer);
|
|
SetLength(FReceivedBuffer,0);
|
|
SetLength(FReceivedBuffer,0);
|
|
|
|
+ FreeAndNil(FPendingResponseMessages);
|
|
inherited;
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
|
|
-function TJSONRPCTcpIpClient.DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean) : TPCJSONObject;
|
|
|
|
|
|
+function TJSONRPCTcpIpClient.DoProcessBuffer(SenderThread : TPCThread; MaxWaitMiliseconds : Cardinal; DeleteBufferOnExit : Boolean; var ResponseMethod : String; var jsonObject : TPCJSONObject) : Boolean;
|
|
var last_bytes_read : Integer;
|
|
var last_bytes_read : Integer;
|
|
jsonData : TPCJSONData;
|
|
jsonData : TPCJSONData;
|
|
tc : Cardinal;
|
|
tc : Cardinal;
|
|
ms : TMemoryStream;
|
|
ms : TMemoryStream;
|
|
- pac : PAnsiChar;
|
|
|
|
- lasti : Integer;
|
|
|
|
|
|
+ i,lasti : Integer;
|
|
continue : Boolean;
|
|
continue : Boolean;
|
|
-begin
|
|
|
|
- Result := Nil;
|
|
|
|
- tc := GetTickCount;
|
|
|
|
- if Assigned(SenderThread) then continue := Not SenderThread.Terminated
|
|
|
|
- else continue := true;
|
|
|
|
- while (Connected) And ((GetTickCount<=(tc+MaxWaitMiliseconds)) Or (MaxWaitMiliseconds=0)) And (continue) do begin
|
|
|
|
- last_bytes_read := 0;
|
|
|
|
- ms := ReadBufferLock;
|
|
|
|
- try
|
|
|
|
- if (ms.Size)>0 then begin
|
|
|
|
- lasti := length(FReceivedBuffer);
|
|
|
|
- setLength(FReceivedBuffer,length(FReceivedBuffer)+ms.Size);
|
|
|
|
- CopyMemory(@FReceivedBuffer[lasti],ms.Memory,ms.Size);
|
|
|
|
- last_bytes_read := ms.Size;
|
|
|
|
- ms.Size := 0;
|
|
|
|
|
|
+ procedure FlushBufferPendingMessages(doSearchId : Boolean; idValue : Integer);
|
|
|
|
+ var l : TList;
|
|
|
|
+ i : Integer;
|
|
|
|
+ P : PPendingResponseMessage;
|
|
|
|
+ Begin
|
|
|
|
+ l := FPendingResponseMessages.LockList;
|
|
|
|
+ Try
|
|
|
|
+ for i := l.count-1 downto 0 do begin
|
|
|
|
+ P := l[i];
|
|
|
|
+ if (doSearchId) And (idValue=P^.id) then begin
|
|
|
|
+ ResponseMethod:=P^.method;
|
|
|
|
+ Dispose(P);
|
|
|
|
+ l.Delete(i);
|
|
|
|
+ end else if (P^.maxDateTime<now) then begin
|
|
|
|
+ TLog.NewLog(lterror,Classname,'Deleting a Pending response message id:'+inttostr(P^.id)+' method:'+P^.method);
|
|
|
|
+ Dispose(P);
|
|
|
|
+ l.Delete(i);
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
finally
|
|
finally
|
|
- ReadBufferUnlock;
|
|
|
|
|
|
+ FPendingResponseMessages.UnlockList;
|
|
end;
|
|
end;
|
|
- if (last_bytes_read>0) then begin
|
|
|
|
- // Delete possible CR+LF or #0 at the end
|
|
|
|
- while (length(FReceivedBuffer)>1) And (FReceivedBuffer[length(FReceivedBuffer)-1] in [10,13,0]) do setLength(FReceivedBuffer,length(FReceivedBuffer)-1);
|
|
|
|
- // Decode
|
|
|
|
- jsonData := TPCJSONData.ParseJSONValue(FReceivedBuffer);
|
|
|
|
- if Assigned(jsonData) then begin
|
|
|
|
- setlength(FReceivedBuffer,0);
|
|
|
|
- if jsonData is TPCJSONObject then begin
|
|
|
|
- Result := TPCJSONObject(jsonData);
|
|
|
|
- exit;
|
|
|
|
- end else begin
|
|
|
|
- TLog.NewLog(lterror,ClassName,'Invalid JSON data: '+jsonData.ClassName);
|
|
|
|
- jsonData.Free;
|
|
|
|
- End;
|
|
|
|
|
|
+ end;
|
|
|
|
+var PartialBuffer : TBytes;
|
|
|
|
+ Function ProcessPartialBuffer : Boolean;
|
|
|
|
+ Var i,istart : Integer;
|
|
|
|
+ aux : TBytes;
|
|
|
|
+ begin
|
|
|
|
+ result := false;
|
|
|
|
+ i := 0; istart :=0;
|
|
|
|
+ while (i<=high(FReceivedBuffer)) do begin
|
|
|
|
+ if FReceivedBuffer[i]<32 then begin
|
|
|
|
+ if i=istart then inc(istart)
|
|
|
|
+ else break;
|
|
end else begin
|
|
end else begin
|
|
- TLog.NewLog(ltDebug,ClassName,Format('Read %d bytes but no valid JSON inside',[last_bytes_read]));
|
|
|
|
end;
|
|
end;
|
|
|
|
+ inc(i);
|
|
end;
|
|
end;
|
|
- sleep(1);
|
|
|
|
|
|
+ if (i>0) And (i>istart) And (i<=High(FReceivedBuffer)) then begin
|
|
|
|
+ SetLength(PartialBuffer,i-istart);
|
|
|
|
+ move(FReceivedBuffer[istart],PartialBuffer[0],i-istart);
|
|
|
|
+ // Inc i until valid char
|
|
|
|
+ while (i<=High(FReceivedBuffer)) And (FReceivedBuffer[i]<32) do inc(i);
|
|
|
|
+ // i is the first valid pos for next buffer
|
|
|
|
+ if i<=High(FReceivedBuffer) then begin
|
|
|
|
+ setlength(aux,length(FReceivedBuffer)-i);
|
|
|
|
+ move(FReceivedBuffer[i],aux[0],length(aux));
|
|
|
|
+ SetLength(FReceivedBuffer,length(aux));
|
|
|
|
+ move(aux[0],FReceivedBuffer[0],length(aux));
|
|
|
|
+ end else begin
|
|
|
|
+ // empty next buffer
|
|
|
|
+ SetLength(FReceivedBuffer,0);
|
|
|
|
+ end;
|
|
|
|
+ Result := true;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+var islocked : Boolean;
|
|
|
|
+begin
|
|
|
|
+ Result := false;
|
|
|
|
+ ResponseMethod := '';
|
|
|
|
+ tc := GetTickCount;
|
|
|
|
+ Repeat
|
|
|
|
+ islocked := FLockProcessBuffer.TryEnter;
|
|
|
|
+ until (islocked) Or ((GetTickCount>(tc+MaxWaitMiliseconds)) And (MaxWaitMiliseconds<>0));
|
|
|
|
+ If Not islocked then exit;
|
|
|
|
+ try
|
|
if Assigned(SenderThread) then continue := Not SenderThread.Terminated
|
|
if Assigned(SenderThread) then continue := Not SenderThread.Terminated
|
|
else continue := true;
|
|
else continue := true;
|
|
- end;
|
|
|
|
- if (length(FReceivedBuffer)>0) And (DeleteBufferOnExit) then begin
|
|
|
|
- TLog.NewLog(lterror,ClassName,AnsiString( Format('Deleting %d bytes from buffer after waiting %d milis',[length(FReceivedBuffer),MaxWaitMiliseconds])));
|
|
|
|
- SetLength(FReceivedBuffer,0);
|
|
|
|
|
|
+ while (Connected) And ((GetTickCount<=(tc+MaxWaitMiliseconds)) Or (MaxWaitMiliseconds=0)) And (continue) do begin
|
|
|
|
+ last_bytes_read := 0;
|
|
|
|
+ ms := ReadBufferLock;
|
|
|
|
+ try
|
|
|
|
+ if (ms.Size)>0 then begin
|
|
|
|
+ lasti := length(FReceivedBuffer);
|
|
|
|
+ setLength(FReceivedBuffer,length(FReceivedBuffer)+ms.Size);
|
|
|
|
+ CopyMemory(@FReceivedBuffer[lasti],ms.Memory,ms.Size);
|
|
|
|
+ last_bytes_read := ms.Size;
|
|
|
|
+ ms.Size := 0;
|
|
|
|
+ end;
|
|
|
|
+ finally
|
|
|
|
+ ReadBufferUnlock;
|
|
|
|
+ end;
|
|
|
|
+ If ProcessPartialBuffer then begin
|
|
|
|
+ // Decode
|
|
|
|
+ jsonData := TPCJSONData.ParseJSONValue(PartialBuffer);
|
|
|
|
+ if Assigned(jsonData) then begin
|
|
|
|
+ if jsonData is TPCJSONObject then begin
|
|
|
|
+ jsonObject.Assign(jsonData);
|
|
|
|
+ If (jsonObject.IndexOfName('id')>=0) And (jsonObject.IndexOfName('method')<0) then begin
|
|
|
|
+ // Is a Response!
|
|
|
|
+ FlushBufferPendingMessages(true,jsonObject.AsInteger('id',0));
|
|
|
|
+ end;
|
|
|
|
+ Result := true;
|
|
|
|
+ exit;
|
|
|
|
+ end else begin
|
|
|
|
+ TLog.NewLog(lterror,ClassName,'Invalid JSON class: '+jsonData.ClassName+' json: '+TBytesToString(PartialBuffer));
|
|
|
|
+ jsonData.Free;
|
|
|
|
+ End;
|
|
|
|
+ end else begin
|
|
|
|
+ TLog.NewLog(lterror,ClassName,Format('Read %d bytes but no valid JSON inside: %s',[last_bytes_read,TBytesToString(PartialBuffer)]));
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ sleep(1);
|
|
|
|
+ if Assigned(SenderThread) then continue := Not SenderThread.Terminated
|
|
|
|
+ else continue := true;
|
|
|
|
+ end;
|
|
|
|
+ if (length(FReceivedBuffer)>0) And (DeleteBufferOnExit) then begin
|
|
|
|
+ TLog.NewLog(lterror,ClassName,AnsiString( Format('Deleting %d bytes from buffer after waiting %d milis: %s',[length(FReceivedBuffer),MaxWaitMiliseconds,TBytesToString(FReceivedBuffer)])));
|
|
|
|
+ SetLength(FReceivedBuffer,0);
|
|
|
|
+ end;
|
|
|
|
+ finally
|
|
|
|
+ FlushBufferPendingMessages(false,0);
|
|
|
|
+ FLockProcessBuffer.Release;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TJSONRPCTcpIpClient.GetNewId: Cardinal;
|
|
function TJSONRPCTcpIpClient.GetNewId: Cardinal;
|
|
begin
|
|
begin
|
|
- inc(FLastId);
|
|
|
|
- Result := FLastId;
|
|
|
|
|
|
+ FLockReceivedBuffer.Acquire;
|
|
|
|
+ try
|
|
|
|
+ inc(FLastId);
|
|
|
|
+ Result := FLastId;
|
|
|
|
+ finally
|
|
|
|
+ FLockReceivedBuffer.Release;
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TJSONRPCTcpIpClient.SendJSONRPCErrorResponse(const id: Variant; const error: String);
|
|
procedure TJSONRPCTcpIpClient.SendJSONRPCErrorResponse(const id: Variant; const error: String);
|
|
@@ -225,6 +341,8 @@ procedure TJSONRPCTcpIpClient.SendJSONRPCMethod(const method: String; params: TP
|
|
Var json : TPCJSONObject;
|
|
Var json : TPCJSONObject;
|
|
stream : TMemoryStream;
|
|
stream : TMemoryStream;
|
|
b : Byte;
|
|
b : Byte;
|
|
|
|
+ P : PPendingResponseMessage;
|
|
|
|
+ l : TList;
|
|
begin
|
|
begin
|
|
json := TPCJSONObject.Create;
|
|
json := TPCJSONObject.Create;
|
|
Try
|
|
Try
|
|
@@ -233,6 +351,15 @@ begin
|
|
json.GetAsArray('params').GetAsObject(0).Assign(params);
|
|
json.GetAsArray('params').GetAsObject(0).Assign(params);
|
|
end;
|
|
end;
|
|
json.GetAsVariant('id').Value := id;
|
|
json.GetAsVariant('id').Value := id;
|
|
|
|
+ if (Not VarIsNull(id)) then begin
|
|
|
|
+ new(P);
|
|
|
|
+ P^.id:=id;
|
|
|
|
+ P^.sendDateTime:=Now;
|
|
|
|
+ P^.maxDateTime:=Now + encodetime(0,0,30,0);
|
|
|
|
+ P^.method:=method;
|
|
|
|
+ FPendingResponseMessages.Add(P);
|
|
|
|
+ end;
|
|
|
|
+ TLog.NewLog(ltdebug,Classname,'Sending JSON-RPC: '+json.ToJSON(false));
|
|
stream := TMemoryStream.Create;
|
|
stream := TMemoryStream.Create;
|
|
try
|
|
try
|
|
json.SaveToStream(stream);
|
|
json.SaveToStream(stream);
|
|
@@ -252,23 +379,45 @@ begin
|
|
End;
|
|
End;
|
|
end;
|
|
end;
|
|
|
|
|
|
-function TJSONRPCTcpIpClient.SendJSONRPCMethodAndWait(const method: String; params: TPCJSONObject; MaxWaitMiliseconds: Cardinal; resultObject : TPCJSONObject) : Boolean;
|
|
|
|
|
|
+function TJSONRPCTcpIpClient.SendJSONRPCMethodAndWait(const method: String; params: TPCJSONObject; MaxWaitMiliseconds: Cardinal; resultObject : TPCJSONObject; processEventOnInvalid : TProcessJSONObjectEvent = Nil) : Boolean;
|
|
Var nId : Cardinal;
|
|
Var nId : Cardinal;
|
|
- tc : Cardinal;
|
|
|
|
|
|
+ tc,maxw : Cardinal;
|
|
json : TPCJSONObject;
|
|
json : TPCJSONObject;
|
|
|
|
+ rm : String;
|
|
begin
|
|
begin
|
|
- nId := GetNewId;
|
|
|
|
Result := false;
|
|
Result := false;
|
|
- SendJSONRPCMethod(method,params,nId);
|
|
|
|
- tc := GetTickCount;
|
|
|
|
- json := DoProcessBuffer(nil,MaxWaitMiliseconds,true);
|
|
|
|
- if Assigned(json) then begin
|
|
|
|
- try
|
|
|
|
- resultObject.Assign(json);
|
|
|
|
- Result := true;
|
|
|
|
|
|
+ FLockProcessBuffer.Acquire;
|
|
|
|
+ try
|
|
|
|
+ nId := GetNewId;
|
|
|
|
+ SendJSONRPCMethod(method,params,nId);
|
|
|
|
+ tc := GetTickCount;
|
|
|
|
+ json := TPCJSONObject.Create;
|
|
|
|
+ Try
|
|
|
|
+ repeat
|
|
|
|
+ maxw := MaxWaitMiliseconds - (GetTickCount - tc);
|
|
|
|
+ if maxw<1 then maxw := 1
|
|
|
|
+ else if maxw>10000 then maxw := 10000;
|
|
|
|
+ If DoProcessBuffer(nil,maxw,true,rm,json) then begin
|
|
|
|
+ If json.AsCardinal('id',0)=nId then begin
|
|
|
|
+ resultObject.Assign(json);
|
|
|
|
+ Result := true;
|
|
|
|
+ end else begin
|
|
|
|
+ TLog.NewLog(ltdebug,classname,'Received a unexpected JSON while waiting for response Id:'+inttostr(nId)+' Received:'+json.ToJSON(false));
|
|
|
|
+ If Assigned(processEventOnInvalid) then begin
|
|
|
|
+ TLog.NewLog(ltdebug,classname,'Sending to process unexpected JSON:'+json.ToJSON(false));
|
|
|
|
+ processEventOnInvalid(json,rm);
|
|
|
|
+ end else TLog.NewLog(ltdebug,Classname,'Lost JSON message! '+json.ToJSON(false));
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ until (Result) Or (GetTickCount > (tc+MaxWaitMiliseconds));
|
|
finally
|
|
finally
|
|
- json.Free;
|
|
|
|
|
|
+ json.free;
|
|
|
|
+ end;
|
|
|
|
+ if (Not Result) then begin
|
|
|
|
+ TLog.NewLog(ltdebug,classname,'Not received a JSON response Id:'+inttostr(nId)+' for method:'+method);
|
|
end;
|
|
end;
|
|
|
|
+ finally
|
|
|
|
+ FLockProcessBuffer.Release;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
@@ -306,6 +455,7 @@ end;
|
|
constructor TPoolMiningServer.Create;
|
|
constructor TPoolMiningServer.Create;
|
|
begin
|
|
begin
|
|
inherited;
|
|
inherited;
|
|
|
|
+ FOnMiningServerNewBlockFound := Nil;
|
|
FIncomingsCounter := 0;
|
|
FIncomingsCounter := 0;
|
|
FClientsWins := 0;
|
|
FClientsWins := 0;
|
|
FClientsCount := 0;
|
|
FClientsCount := 0;
|
|
@@ -325,15 +475,20 @@ begin
|
|
inherited;
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure TPoolMiningServer.DoProcessJSON(json: TPCJSONObject; Client : TJSONRPCTcpIpClient);
|
|
|
|
|
|
+procedure TPoolMiningServer.DoProcessJSON(json: TPCJSONObject; ResponseMethod : String; Client : TJSONRPCTcpIpClient);
|
|
Var method : String;
|
|
Var method : String;
|
|
params : TPCJSONArray;
|
|
params : TPCJSONArray;
|
|
id_value : Variant;
|
|
id_value : Variant;
|
|
i : Integer;
|
|
i : Integer;
|
|
response_result : TPCJSONObject;
|
|
response_result : TPCJSONObject;
|
|
begin
|
|
begin
|
|
- method := json.AsString('method','');
|
|
|
|
- params := json.GetAsArray('params');
|
|
|
|
|
|
+ If ResponseMethod<>'' then begin
|
|
|
|
+ method := ResponseMethod;
|
|
|
|
+ params := json.GetAsArray('result');
|
|
|
|
+ end else begin
|
|
|
|
+ method := json.AsString('method','');
|
|
|
|
+ params := json.GetAsArray('params');
|
|
|
|
+ end;
|
|
i := json.IndexOfName('id');
|
|
i := json.IndexOfName('id');
|
|
if i<0 then begin
|
|
if i<0 then begin
|
|
id_value := Null;
|
|
id_value := Null;
|
|
@@ -383,7 +538,7 @@ end;
|
|
procedure TPoolMiningServer.FillMineValue(mine_values: TPCJSONObject; Client : TJSONRPCTcpIpClient);
|
|
procedure TPoolMiningServer.FillMineValue(mine_values: TPCJSONObject; Client : TJSONRPCTcpIpClient);
|
|
Var Op : TPCOperationsComp;
|
|
Var Op : TPCOperationsComp;
|
|
begin
|
|
begin
|
|
- mine_values.GetAsVariant('block').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.block;
|
|
|
|
|
|
+ mine_values.GetAsVariant('block').Value := FNodeNotifyEvents.Node.Bank.LastBlockFound.OperationBlock.block+1;
|
|
mine_values.GetAsVariant('version').Value := FNodeNotifyEvents.Node.Operations.OperationBlock.protocol_version;
|
|
mine_values.GetAsVariant('version').Value := FNodeNotifyEvents.Node.Operations.OperationBlock.protocol_version;
|
|
Op := TPCOperationsComp.Create(Nil);
|
|
Op := TPCOperationsComp.Create(Nil);
|
|
try
|
|
try
|
|
@@ -439,7 +594,7 @@ begin
|
|
p1 := nbOperations.PoW_Digest_Part1;
|
|
p1 := nbOperations.PoW_Digest_Part1;
|
|
p2 := nbOperations.PoW_Digest_Part2_Payload;
|
|
p2 := nbOperations.PoW_Digest_Part2_Payload;
|
|
p3 := nbOperations.PoW_Digest_Part3;
|
|
p3 := nbOperations.PoW_Digest_Part3;
|
|
- If FNodeNotifyEvents.Node.AddNewBlockChain(nil,nil,nbOperations,nba,errors) then begin
|
|
|
|
|
|
+ If FNodeNotifyEvents.Node.AddNewBlockChain(nil,nbOperations,nba,errors) then begin
|
|
// CONGRATS !!!
|
|
// CONGRATS !!!
|
|
json := TPCJSONObject.Create;
|
|
json := TPCJSONObject.Create;
|
|
try
|
|
try
|
|
@@ -453,6 +608,7 @@ begin
|
|
finally
|
|
finally
|
|
json.Free;
|
|
json.Free;
|
|
end;
|
|
end;
|
|
|
|
+ if Assigned(FOnMiningServerNewBlockFound) then FOnMiningServerNewBlockFound(Self);
|
|
end else begin
|
|
end else begin
|
|
Client.SendJSONRPCErrorResponse(id,'Error: '+errors+' payload:'+nbOperations.BlockPayload+' timestamp:'+InttoStr(nbOperations.timestamp)+' nonce:'+IntToStr(nbOperations.nonce));
|
|
Client.SendJSONRPCErrorResponse(id,'Error: '+errors+' payload:'+nbOperations.BlockPayload+' timestamp:'+InttoStr(nbOperations.timestamp)+' nonce:'+IntToStr(nbOperations.nonce));
|
|
end;
|
|
end;
|
|
@@ -466,6 +622,7 @@ var bClient : TJSONRPCTcpIpClient;
|
|
init_json : TPCJSONObject;
|
|
init_json : TPCJSONObject;
|
|
jsonobj : TPCJSONObject;
|
|
jsonobj : TPCJSONObject;
|
|
doDelete : Boolean;
|
|
doDelete : Boolean;
|
|
|
|
+ rmethod : String;
|
|
begin
|
|
begin
|
|
inherited;
|
|
inherited;
|
|
inc(FClientsCount);
|
|
inc(FClientsCount);
|
|
@@ -483,13 +640,13 @@ begin
|
|
End;
|
|
End;
|
|
while (Active) And (Client.Connected) do begin
|
|
while (Active) And (Client.Connected) do begin
|
|
doDelete := bClient.LastReadTC+1000<GetTickCount; // TODO: Protect GetTickCount overflow
|
|
doDelete := bClient.LastReadTC+1000<GetTickCount; // TODO: Protect GetTickCount overflow
|
|
- jsonobj := bClient.DoProcessBuffer(nil,100,doDelete);
|
|
|
|
- if assigned(jsonobj) then begin
|
|
|
|
- try
|
|
|
|
- DoProcessJSON(jsonobj,bClient);
|
|
|
|
- finally
|
|
|
|
- jsonobj.Free;
|
|
|
|
|
|
+ jsonobj := TPCJSONObject.Create;
|
|
|
|
+ try
|
|
|
|
+ if bClient.DoProcessBuffer(nil,1000,doDelete,rmethod,jsonobj) then begin
|
|
|
|
+ DoProcessJSON(jsonobj,rmethod,bClient);
|
|
end;
|
|
end;
|
|
|
|
+ finally
|
|
|
|
+ jsonobj.free;
|
|
end;
|
|
end;
|
|
sleep(10);
|
|
sleep(10);
|
|
end;
|
|
end;
|
|
@@ -574,17 +731,22 @@ begin
|
|
inherited;
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
|
|
-procedure TPoolMinerClient.DoProcessJSONObject(json: TPCJSONObject);
|
|
|
|
|
|
+procedure TPoolMinerClient.DoProcessJSONObject(json: TPCJSONObject; ResponseMethod : String);
|
|
Var method : String;
|
|
Var method : String;
|
|
- params : TPCJSONArray;
|
|
|
|
id_value : Variant;
|
|
id_value : Variant;
|
|
i : Integer;
|
|
i : Integer;
|
|
params_object : TPCJSONObject;
|
|
params_object : TPCJSONObject;
|
|
mvfw : TMinerValuesForWork;
|
|
mvfw : TMinerValuesForWork;
|
|
begin
|
|
begin
|
|
TLog.NewLog(ltdebug,ClassName,'Received JSON: '+json.ToJSON(false));
|
|
TLog.NewLog(ltdebug,ClassName,'Received JSON: '+json.ToJSON(false));
|
|
- method := json.AsString('method','');
|
|
|
|
- params := json.GetAsArray('params');
|
|
|
|
|
|
+ if (ResponseMethod<>'') then begin
|
|
|
|
+ method := ResponseMethod;
|
|
|
|
+ params_object := json.GetAsObject('result');
|
|
|
|
+ TLog.NewLog(ltinfo,classname,'Received response method:'+ResponseMethod+' JSON:'+json.ToJSON(false));
|
|
|
|
+ end else begin
|
|
|
|
+ method := json.AsString('method','');
|
|
|
|
+ params_object := json.GetAsArray('params').GetAsObject(0);
|
|
|
|
+ end;
|
|
i := json.IndexOfName('id');
|
|
i := json.IndexOfName('id');
|
|
if i<0 then begin
|
|
if i<0 then begin
|
|
id_value := Null;
|
|
id_value := Null;
|
|
@@ -592,7 +754,6 @@ begin
|
|
id_value := json.GetAsVariant('id').Value;
|
|
id_value := json.GetAsVariant('id').Value;
|
|
end;
|
|
end;
|
|
if method=CT_PoolMining_Method_MINER_NOTIFY then begin
|
|
if method=CT_PoolMining_Method_MINER_NOTIFY then begin
|
|
- params_object := params.GetAsObject(0);
|
|
|
|
mvfw := CT_TMinerValuesForWork_NULL;
|
|
mvfw := CT_TMinerValuesForWork_NULL;
|
|
mvfw.block := params_object.AsInteger('block',0);
|
|
mvfw.block := params_object.AsInteger('block',0);
|
|
mvfw.version := params_object.AsInteger('version',0);
|
|
mvfw.version := params_object.AsInteger('version',0);
|
|
@@ -603,7 +764,7 @@ begin
|
|
mvfw.timestamp := params_object.AsInteger('timestamp',0);
|
|
mvfw.timestamp := params_object.AsInteger('timestamp',0);
|
|
mvfw.part1 := TCrypto.HexaToRaw(params_object.AsString('part1',''));
|
|
mvfw.part1 := TCrypto.HexaToRaw(params_object.AsString('part1',''));
|
|
mvfw.target_pow := TCrypto.HexaToRaw(params_object.AsString('target_pow',''));
|
|
mvfw.target_pow := TCrypto.HexaToRaw(params_object.AsString('target_pow',''));
|
|
- if Not VarIsNull(id_value) then begin
|
|
|
|
|
|
+ if (Not VarIsNull(id_value)) And (ResponseMethod='') then begin
|
|
SendJSONRPCResponse(params_object,id_value);
|
|
SendJSONRPCResponse(params_object,id_value);
|
|
end;
|
|
end;
|
|
MinerValuesForWork := mvfw;
|
|
MinerValuesForWork := mvfw;
|
|
@@ -611,21 +772,54 @@ begin
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TPoolMinerClient.SetMinerValuesForWork(const Value: TMinerValuesForWork);
|
|
procedure TPoolMinerClient.SetMinerValuesForWork(const Value: TMinerValuesForWork);
|
|
|
|
+Var _t : Cardinal;
|
|
|
|
+ _t_pow : TRawBytes;
|
|
begin
|
|
begin
|
|
FMinerValuesForWork := Value;
|
|
FMinerValuesForWork := Value;
|
|
|
|
+ // Check that target and target_pow are equal!
|
|
|
|
+ _t_pow := TPCBank.TargetFromCompact(FMinerValuesForWork.target);
|
|
|
|
+ if (length(FMinerValuesForWork.target_pow)=32) then begin
|
|
|
|
+ _t := TPCBank.TargetToCompact(FMinerValuesForWork.target_pow);
|
|
|
|
+ if (FMinerValuesForWork.target<CT_MinCompactTarget) then begin
|
|
|
|
+ // target has no valid value... assigning compact_target!
|
|
|
|
+ FMinerValuesForWork.target:=TPCBank.TargetToCompact(_t_pow);
|
|
|
|
+ end else if (_t_pow<>FMinerValuesForWork.target_pow) Or (_t<>FMinerValuesForWork.target) then begin
|
|
|
|
+ TLog.NewLog(ltError,Classname,'Received bad values for target and target_pow!');
|
|
|
|
+ If (FMinerValuesForWork.target<CT_MinCompactTarget) then begin
|
|
|
|
+ FMinerValuesForWork.target_pow:=TPCBank.TargetFromCompact(FMinerValuesForWork.target);
|
|
|
|
+ end else begin
|
|
|
|
+ FMinerValuesForWork.target:=TPCBank.TargetToCompact(_t_pow);
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ end else begin
|
|
|
|
+ if (FMinerValuesForWork.target<CT_MinCompactTarget) then begin
|
|
|
|
+ // target_pow has no value... assigning target!
|
|
|
|
+ FMinerValuesForWork.target_pow:=TPCBank.TargetFromCompact(FMinerValuesForWork.target);
|
|
|
|
+ end else begin
|
|
|
|
+ // Invalid target and compact_target
|
|
|
|
+ FMinerValuesForWork.target := CT_TMinerValuesForWork_NULL.target;
|
|
|
|
+ FMinerValuesForWork.target_pow := CT_TMinerValuesForWork_NULL.target_pow;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
if Assigned(FOnMinerMustChangeValues) then FOnMinerMustChangeValues(Self);
|
|
if Assigned(FOnMinerMustChangeValues) then FOnMinerMustChangeValues(Self);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TPoolMinerClient.SubmitBlockFound(const Payload: TRawBytes; Timestamp, NOnce: Cardinal);
|
|
procedure TPoolMinerClient.SubmitBlockFound(const Payload: TRawBytes; Timestamp, NOnce: Cardinal);
|
|
-Var json : TPCJSONObject;
|
|
|
|
|
|
+Var json, resultJSON : TPCJSONObject;
|
|
|
|
+ nOnceAsSignedInt : Int32;
|
|
begin
|
|
begin
|
|
json := TPCJSONObject.Create;
|
|
json := TPCJSONObject.Create;
|
|
Try
|
|
Try
|
|
|
|
+ nOnceAsSignedInt := NOnce;
|
|
json.GetAsVariant('payload').Value := TCrypto.ToHexaString(Payload);
|
|
json.GetAsVariant('payload').Value := TCrypto.ToHexaString(Payload);
|
|
json.GetAsVariant('timestamp').Value := Timestamp;
|
|
json.GetAsVariant('timestamp').Value := Timestamp;
|
|
- json.GetAsVariant('nonce').Value := NOnce;
|
|
|
|
- SendJSONRPCMethod(CT_PoolMining_Method_MINER_SUBMIT,json,5000);
|
|
|
|
-// Example: {"method":"miner-submit","params":[{"payload":"57617368696E67746F6E3117","timestamp":1234567890,"nonce":1234}]}
|
|
|
|
|
|
+ json.GetAsVariant('nonce').Value := nOnceAsSignedInt;
|
|
|
|
+ resultJSON := TPCJSONObject.Create;
|
|
|
|
+ try
|
|
|
|
+ SendJSONRPCMethod(CT_PoolMining_Method_MINER_SUBMIT,json,GetNewId);
|
|
|
|
+ Finally
|
|
|
|
+ resultJSON.free;
|
|
|
|
+ end;
|
|
Finally
|
|
Finally
|
|
json.Free;
|
|
json.Free;
|
|
End;
|
|
End;
|