From 6735c0ece2636dff4f13cf3d00dc97fdce75d6cb Mon Sep 17 00:00:00 2001 From: AndreaLanfranchi Date: Sun, 15 Jul 2018 18:25:40 +0200 Subject: [PATCH] Initial Commit --- Api/ApiClient.vb | 306 +++++++++ Api/ApiServer.vb | 241 +++++++ Clients/Client.vb | 1052 +++++++++++++++++++++++++++++++ Clients/ClientInfo.vb | 75 +++ Clients/ClientsManager.vb | 285 +++++++++ Core/App.vb | 123 ++++ Core/Donate.vb | 46 ++ Core/Extensions.vb | 136 ++++ Core/Helpers.vb | 555 ++++++++++++++++ Core/Job.vb | 61 ++ Core/Settings.vb | 89 +++ Core/SlidingQueue.vb | 55 ++ Core/SocketStack.vb | 93 +++ Core/Telemetry.vb | 302 +++++++++ Core/Worker.vb | 61 ++ Logger.vb | 72 +++ Pools/Pool.vb | 373 +++++++++++ Pools/PoolManager.vb | 1183 +++++++++++++++++++++++++++++++++++ Program.vb | 542 ++++++++++++++++ RangeTree/IRangeProvider.vb | 31 + RangeTree/IRangeTree.vb | 45 ++ RangeTree/Range.vb | 260 ++++++++ RangeTree/RangeTree.vb | 231 +++++++ RangeTree/RangeTreeNode.vb | 211 +++++++ RangeTree/WorkerRange.vb | 47 ++ Sockets/AsyncSocket.vb | 707 +++++++++++++++++++++ 26 files changed, 7182 insertions(+) create mode 100644 Api/ApiClient.vb create mode 100644 Api/ApiServer.vb create mode 100644 Clients/Client.vb create mode 100644 Clients/ClientInfo.vb create mode 100644 Clients/ClientsManager.vb create mode 100644 Core/App.vb create mode 100644 Core/Donate.vb create mode 100644 Core/Extensions.vb create mode 100644 Core/Helpers.vb create mode 100644 Core/Job.vb create mode 100644 Core/Settings.vb create mode 100644 Core/SlidingQueue.vb create mode 100644 Core/SocketStack.vb create mode 100644 Core/Telemetry.vb create mode 100644 Core/Worker.vb create mode 100644 Logger.vb create mode 100644 Pools/Pool.vb create mode 100644 Pools/PoolManager.vb create mode 100644 Program.vb create mode 100644 RangeTree/IRangeProvider.vb create mode 100644 RangeTree/IRangeTree.vb create mode 100644 RangeTree/Range.vb create mode 100644 RangeTree/RangeTree.vb create mode 100644 RangeTree/RangeTreeNode.vb create mode 100644 RangeTree/WorkerRange.vb create mode 100644 Sockets/AsyncSocket.vb diff --git a/Api/ApiClient.vb b/Api/ApiClient.vb new file mode 100644 index 0000000..c387d58 --- /dev/null +++ b/Api/ApiClient.vb @@ -0,0 +1,306 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports nethproxy.Sockets +Imports System.Json +Imports System.Net +Imports System.Net.Sockets +Imports System.Text + +Namespace Api + + Public Class ApiClient + + ' Pointers to singletons + Private _settings As Core.Settings + Private _clntmgr As Clients.ClientsManager + + ' The base socket handler + Private WithEvents _socket As AsyncSocket = Nothing + + ' Logging Context + Private _context As String = "Api" + Private _lockObj As New Object + + Public ReadOnly Property Id As String ' Unique identifier + +#Region " Constructor" + + Private Sub New() + End Sub + + + Public Sub New(ByRef acceptedSocket As Socket) + + ' Retrieve singletons + _settings = App.Instance.Settings + _clntmgr = App.Instance.ClntMgr + + ' Start a new async socket + _Id = acceptedSocket.RemoteEndPoint.ToString() + _socket = New AsyncSocket(acceptedSocket, "Api") + _socket.BeginReceive() + + End Sub + + +#End Region + +#Region " Properties" + + ''' + ''' Whether or not this socket is connected + ''' + ''' + Public ReadOnly Property IsConnected + Get + If _socket Is Nothing Then Return False + Return _socket.IsConnected + End Get + End Property + + ''' + ''' Returns the remote endpoint of the underlying socket + ''' + ''' True / False + Public ReadOnly Property RemoteEndPoint As IPEndPoint + Get + If _socket Is Nothing Then Return Nothing + Return _socket.RemoteEndPoint + End Get + End Property + + ''' + ''' Returns how much time this connection has been idle + ''' + ''' A object + Public ReadOnly Property IdleDuration As TimeSpan + Get + If _socket Is Nothing Then Return New TimeSpan(0, 0, 0) + Return _socket.IdleDuration + End Get + End Property + + ''' + ''' Gets the time of connection of this worker + ''' + ''' + Public ReadOnly Property ConnectedTimeStamp As DateTime + Get + If _socket Is Nothing Then Return DateTime.MinValue + Return _socket.ConnectedTimestamp + End Get + End Property + + ''' + ''' Gets the duration of this worker's connection + ''' + ''' + Public ReadOnly Property ConnectionDuration As TimeSpan + Get + If _socket Is Nothing Then + Return New TimeSpan(0, 0, 0) + End If + Return _socket.ConnectionDuration + End Get + End Property + + + +#End Region + +#Region " Events" + + Public Event Disconnected(ByRef sender As ApiClient) + +#End Region + +#Region " Methods" + + ''' + ''' Issues immediate disconnection of the underlying socket + ''' and signals client disconnection + ''' + Public Sub Disconnect() + + _socket.Disconnect() + If DisconnectedEvent IsNot Nothing Then RaiseEvent Disconnected(Me) + + End Sub + + ''' + ''' Handles the incoming message + ''' + ''' A Json object string + Private Sub ProcessMessage(message As String) + + ' Out message received + If _settings.LogVerbosity >= 9 Then Logger.Log(9, "<< " & message, _context) + + Dim jReq As JsonObject = Nothing + Dim jRes As JsonObject = New JsonObject + Dim msgId As Integer = 0 + Dim msgMethod As String = String.Empty + + jRes("id") = Nothing + jRes("jsonrpc") = "2.0" + + + Try + + jReq = JsonValue.Parse(message) + With jReq + If .ContainsKey("id") Then .TryGetValue("id", msgId) + If .ContainsKey("method") Then .TryGetValue("method", msgMethod) + If Not .ContainsKey("jsonrpc") Then Throw New Exception("Missing jsonrpc member") + If Not .Item("jsonrpc") = "2.0" Then Throw New Exception("Invalid jsonrpc value") + End With + + Catch ex As Exception + + ' Invalid format of json + Logger.Log(0, String.Format("Json parse failed from api client {1} : {0}", ex.GetBaseException.Message, Id), _context) + jRes("error") = New JsonObject From { + New KeyValuePair(Of String, JsonValue)("code", -32700), + New KeyValuePair(Of String, JsonValue)("message", ex.GetBaseException.Message) + } + _socket.Send(jRes.ToString) + + Return + + End Try + + ' Apply message id + ' as we respond with the same + jRes("id") = msgId + + + ' Handle message + Select Case True + + Case msgMethod = "ping" + + ' Reply to proxy check of liveness + jRes("result") = "pong" + _socket.Send(jRes.ToString) + + Case msgMethod = "quit" + + ' Close the underlying connection + jRes("result") = True + _socket.Send(jRes.ToString) + + Call Disconnect() + + Case msgMethod = "workers.getlist" + + ' Retrieve a list of connected miners + Dim jArr As Json.JsonArray = New Json.JsonArray + Dim cList As List(Of Clients.Client) = _clntmgr.Clients.ToList() + If cList.Count > 0 Then + + ' Sort workers by name + cList.Sort(Function(x As Clients.Client, y As Clients.Client) + Return x.WorkerOrId.CompareTo(y.WorkerOrId) + End Function) + Dim i As Integer = 0 + + For Each c As Clients.Client In cList.OrderBy(Function(s) s.WorkerOrId) + i += 1 + Dim jItem As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("index", i), + New KeyValuePair(Of String, JsonValue)("connected", c.IsConnected), + New KeyValuePair(Of String, JsonValue)("runtime", c.ConnectionDuration.TotalSeconds()), + New KeyValuePair(Of String, JsonValue)("worker", c.WorkerOrId), + New KeyValuePair(Of String, JsonValue)("hashrate", c.HashRate), + New KeyValuePair(Of String, JsonValue)("submitted", c.SolutionsSubmitted), + New KeyValuePair(Of String, JsonValue)("stales", c.KnownStaleSolutions), + New KeyValuePair(Of String, JsonValue)("accepted", c.SolutionsAccepted), + New KeyValuePair(Of String, JsonValue)("rejected", c.SolutionsRejected), + New KeyValuePair(Of String, JsonValue)("lastsubmit", c.LastSubmittedTimestamp.ToString())} + jArr.Add(jItem) + + Next + + jRes("result")("count") = i + + + Else + + jRes("result")("count") = 0 + + End If + + jRes("result")("workers") = jArr + _socket.Send(jRes.ToString) + + Case Else + + ' Any other not implemented (yet ?) + jRes("error") = New JsonObject From { + New KeyValuePair(Of String, JsonValue)("code", -32700), + New KeyValuePair(Of String, JsonValue)("message", "Method Not implement or Not available") + } + _socket.Send(jRes.ToString) + Logger.Log(0, String.Format("Client {0} sent invalid method {1}", Id, msgMethod), _context) + + End Select + + + End Sub + + ''' + ''' Sends the specified message through the underlying socket + ''' + ''' + Public Sub Send(ByVal message As String) + + _socket.Send(message) + + End Sub + + + +#End Region + +#Region " Async Socket Event Handlers" + + Private Sub OnSocketConnected(ByRef sender As AsyncSocket) Handles _socket.Connected + Logger.Log(3, String.Format("New API connection from {0}", sender.RemoteEndPoint.ToString()), _context) + End Sub + + Private Sub OnSocketDisconnected(ByRef sender As AsyncSocket) Handles _socket.Disconnected + + Disconnect() + + End Sub + + Private Sub OnSocketMessageReceived(ByRef sender As AsyncSocket, ByVal message As String) Handles _socket.MessageReceived + + ' Queue the message processing + ProcessMessage(message) + + End Sub + +#End Region + + End Class + +End Namespace diff --git a/Api/ApiServer.vb b/Api/ApiServer.vb new file mode 100644 index 0000000..73060db --- /dev/null +++ b/Api/ApiServer.vb @@ -0,0 +1,241 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports System.Net.Sockets + +Namespace Api + + Public Class ApiServer + +#Region " Fields" + + ' Ref to Singletons + Private _telemetry As Telemetry = App.Instance.Telemetry + Private _settings As Settings = App.Instance.Settings + Private _poolmgr As Pools.PoolManager = App.Instance.PoolMgr + + ' Logging context + Protected _context As String = "Api" + Protected Shared _lockObj As New Object + + ' This is server socket + Private _serverSocket As Socket + Private _isRunning As Boolean = False + + ' Here is our list of connected clients + Protected _clientsList As New List(Of ApiClient) + +#End Region + +#Region " Constructor" + + Public Sub New() + End Sub + +#End Region + +#Region " Methods" + + ''' + ''' Starts the server and begin listen for incoming connections + ''' + ''' True or False + Public Function Start() As Boolean + + If _settings.ApiListenerEndPoint Is Nothing Then Return False + + Try + + _serverSocket = New Socket(_settings.ApiListenerEndPoint.AddressFamily, SocketType.Stream, ProtocolType.Tcp) + + ' Now make it a listener socket at the IP address and port that we specified + _serverSocket.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReuseAddress, 1) + _serverSocket.Bind(_settings.ApiListenerEndPoint) + + ' Now start listening on the listener socket and wait for asynchronous client connections + _serverSocket.Listen(Core.DEFAULT_MAX_CONNECTIONS) + Logger.Log(1, String.Format("Accepting client connections on {0}", _settings.ApiListenerEndPoint), _context) + + _isRunning = True + + ' Begin accepting connections + StartAcceptClientAsync() + + Return True + + Catch ex As Exception + + Logger.Log(0, ex.GetBaseException.Message, _context) + Return False + + End Try + + + End Function + + ''' + ''' This method is called once to stop the server if it is started. + ''' + Public Sub [Stop]() + + _isRunning = False + + ' Close all clients + While _clientsList.Count > 0 + _clientsList(_clientsList.Count - 1).Disconnect() + End While + + If _serverSocket IsNot Nothing Then + + Try + + _serverSocket.Shutdown(SocketShutdown.Both) + _serverSocket.Disconnect(True) + _serverSocket.Close() + _serverSocket.Dispose() + + Catch ex As Exception + + End Try + + End If + + End Sub + + ''' + ''' Processes the accept socket connection + ''' + ''' An object + Public Sub ProcessClientAccept(e As SocketAsyncEventArgs) + + ' First we get the accept socket from the passed in arguments + Dim acceptSocket As Socket = e.AcceptSocket + + ' If the accept socket is connected to a client we will process it + ' otherwise nothing happens + If acceptSocket.Connected Then + + + If _isRunning Then + + + Try + + Logger.Log(1, String.Format("Connection request from {0}", acceptSocket.RemoteEndPoint.ToString), _context) + + ' Initialize a new client which will begin to receive + ' immediately + SyncLock _lockObj + + Dim newClient As New ApiClient(e.AcceptSocket) + AddHandler newClient.Disconnected, AddressOf OnClientDisconnected + _clientsList.Add(newClient) + + End SyncLock + + Catch ex As Exception + + acceptSocket.Disconnect(False) + acceptSocket.Close() + Logger.Log(0, ex.GetBaseException.Message, _context) + + End Try + + ' Start the process again to wait for the next connection + StartAcceptClientAsync() + + Else + + Logger.Log(1, String.Format("Connection request from {0} rejected: Stopping ...", acceptSocket.RemoteEndPoint.ToString), _context) + acceptSocket.Disconnect(False) + acceptSocket.Close() + + End If + + + End If + + + End Sub + +#End Region + +#Region " Async Worker" + + ''' + ''' This method implements the asynchronous loop of events + ''' that accepts incoming client connections + ''' + Public Sub StartAcceptClientAsync(Optional e As SocketAsyncEventArgs = Nothing) + + If Not _isRunning Then Return + + ' If there is not an accept socket, create it + ' If there is, reuse it + If (e Is Nothing) Then + e = New SocketAsyncEventArgs() + AddHandler e.Completed, AddressOf OnClientAcceptCompleted + Else + e.AcceptSocket = Nothing + End If + + ' If there are no connections waiting to be processed then we can go ahead and process the accept. + ' Otherwise, the Completed event we tacked onto the accept socket will do it when it completes + If Not (_serverSocket.AcceptAsync(e)) Then + ProcessClientAccept(e) + End If + + End Sub + + +#End Region + +#Region " Events Handlers" + + ''' + ''' Handles acceptance of new client socket + ''' + Private Sub OnClientAcceptCompleted(sender As Object, e As SocketAsyncEventArgs) + + If (e Is Nothing OrElse (e.SocketError <> SocketError.Success)) Then Return + ProcessClientAccept(e) + + End Sub + + ''' + ''' Handles client disconnection + ''' + ''' The disconnected client + Public Sub OnClientDisconnected(ByRef sender As ApiClient) + + RemoveHandler sender.Disconnected, AddressOf OnClientDisconnected + _clientsList.Remove(sender) + + Logger.Log(6, String.Format("Total clients now {0}", _telemetry.ConnectedMiners), _context) + + End Sub + + +#End Region + + + End Class + +End Namespace \ No newline at end of file diff --git a/Clients/Client.vb b/Clients/Client.vb new file mode 100644 index 0000000..d1cc6ca --- /dev/null +++ b/Clients/Client.vb @@ -0,0 +1,1052 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports nethproxy.RangeTree +Imports nethproxy.Sockets +Imports System.Json +Imports System.Net +Imports System.Net.Sockets +Imports System.Threading + +Namespace Clients + + Public Class Client + Implements IDisposable + + ' Main Socket + Private _clientStatus As ClientStatus = ClientStatus.NotConnected + Private WithEvents _socket As AsyncSocket = Nothing ' This is work socket to deploy jobs and receive solutions + + ' Api Socket + Private WithEvents _apisocket As AsyncSocket = Nothing ' This is the socket to connect to client's API + Private _apiMessagesQueue As New Concurrent.ConcurrentQueue(Of String) + + ' Timers for events + Private WithEvents _scheduleTimer As Timers.Timer ' Triggers scheduled operations + Private _scheduleRunning As Boolean = False + + ' Reference to singletons + Private WithEvents _poolmgr As Pools.PoolManager = App.Instance.PoolMgr + Private _clntmgr As ClientsManager = App.Instance.ClntMgr + Private _telemetry As Telemetry = App.Instance.Telemetry + Private _settings As Settings = App.Instance.Settings + + ' Logging Context + Private _context As String = "Worker" + Private _lockObj As New Object + + ' Client specific members + Private _id As String + Private _workerName As String = String.Empty + + ' Api specific + Public Property ApiEndPoint As IPEndPoint + Public Property ApiAvailable As Boolean = False + Public Property ApiConnectionAttempts As Integer = 0 + + Private _apiInfoPending As Boolean = False + Private _apiScrambleInfoPending As Boolean = False + + ' Data Pulled From API Calls + Public Property ApiInfo As ClientInfo ' Info pulled from miner_getstathr + Public Property ApiScrambleInfo As ClientScrambleInfo ' Info pulled from miner_getscramblerinfo + Public Property ApiSegmentCheckedOn As DateTime = DateTime.MinValue ' Date/time segment was checked/narrowed/enlarged + + ' Statistics + Public HashRate As Decimal = Decimal.Zero + Public MaxHashRate As Decimal = Decimal.Zero + Public SolutionsSubmitted As Long = 0 + Public SolutionsAccepted As Long = 0 + Public SolutionsRejected As Long = 0 + Public KnownStaleSolutions As Long = 0 + Public LastSubmittedTimestamp As DateTime = DateTime.MinValue + +#Region " Properties" + + ''' + ''' Gets the unique id for this client + ''' + ''' A string + Public ReadOnly Property Id As String + Get + Return _id + End Get + End Property + + ''' + ''' Gets the time of connection of this worker + ''' + ''' + Public ReadOnly Property ConnectedTimeStamp As DateTime + Get + If _socket Is Nothing Then Return DateTime.MinValue + Return _socket.ConnectedTimestamp + End Get + End Property + + ''' + ''' Gets the duration of this worker's connection + ''' + ''' + Public ReadOnly Property ConnectionDuration As TimeSpan + Get + If _socket Is Nothing Then + Return New TimeSpan(0, 0, 0) + End If + Return _socket.ConnectionDuration + End Get + End Property + + ''' + ''' Gets the amount of time this client has been idle + ''' + ''' + Public ReadOnly Property IdleDuration As TimeSpan + Get + If _socket Is Nothing Then Return New TimeSpan(0, 0, 0) + Return _socket.IdleDuration + End Get + End Property + + ''' + ''' Gets whether or not the underlying socket is connected + ''' + ''' True / False + Public ReadOnly Property IsConnected As Boolean + Get + If disposedValue Then Return False + If _socket Is Nothing Then + Return False + Else + Return _socket.IsConnected() + End If + End Get + End Property + + ''' + ''' Whether or not client is Sbuscribed + ''' + ''' + Public ReadOnly Property IsSubscribed As Boolean + Get + Return _clientStatus.HasFlag(ClientStatus.Subscribed) + End Get + End Property + + ''' + ''' Whether or not client is Authorized + ''' + ''' + Public ReadOnly Property IsAuthorized As Boolean + Get + Return _clientStatus.HasFlag(ClientStatus.Authorized) + End Get + End Property + + ''' + ''' Gets whether or not the underlying API socket is connected + ''' + ''' + Public ReadOnly Property IsAPIConnected As Boolean + Get + If _apiEndPoint Is Nothing Then Return False + If _apisocket Is Nothing Then Return False + Return _apisocket.IsConnected() + End Get + End Property + + ''' + ''' Returns the remote endpoint of the underlying socket + ''' + ''' True / False + Public ReadOnly Property RemoteEndPoint As IPEndPoint + Get + If _socket Is Nothing Then Return Nothing + Return _socket.RemoteEndPoint + End Get + End Property + + ''' + ''' Returns the name of the worker as reported during + ''' subscribe / authorize process + ''' + ''' A string + Public ReadOnly Property WorkerName As String + Get + Return _workerName + End Get + End Property + + ''' + ''' Returns Worker Name or Id if the first is empty + ''' + ''' A string + Public ReadOnly Property WorkerOrId As String + Get + If String.IsNullOrEmpty(_workerName) Then + Return _id + Else + Return _workerName + End If + End Get + End Property + + +#End Region + +#Region " Events" + + Public Event Disconnected(ByRef sender As Client) + +#End Region + +#Region " Constructor" + + ' Inhibit factory method + Private Sub New() + End Sub + + ''' + ''' Default constructor + ''' + ''' The object accepted by the listener + Public Sub New(ByRef acceptedSocket As Socket) + + ' Start a new async socket + _socket = New AsyncSocket(acceptedSocket) + _id = _socket.RemoteEndPoint.ToString() + _clientStatus.SetFlags({ClientStatus.Connected}) + _clientStatus.UnsetFlags({ClientStatus.NotConnected, ClientStatus.Subscribed, ClientStatus.Authorized}) + _socket.BeginReceive() + + ' Start internal scheduler with a random interval among 10 and 30 seconds + _scheduleTimer = New Timers.Timer With {.Interval = (GetRandom(10, 30) * 1000), .AutoReset = False, .Enabled = True} + + End Sub + +#End Region + +#Region " Methods" + + ''' + ''' Issues immediate disconnection of the underlying socket + ''' and signals client disconnection + ''' + Public Sub Disconnect() + + If _clientStatus.HasFlag(ClientStatus.NotConnected) Then Return + + _clientStatus.SetFlags({ClientStatus.NotConnected}) + _clientStatus.UnsetFlags({ClientStatus.Connected, ClientStatus.Authorized, ClientStatus.Subscribed}) + + _scheduleTimer.Enabled = False + StopApiConnection() + + If _socket IsNot Nothing AndAlso _socket.IsConnected Then + _socket.Disconnect() + End If + + ' Remove from Telemetry the segment of this Client + Dim WorkerRange As WorkerRangeItem = Nothing + SyncLock _telemetry.Lock + + Try + + WorkerRange = _telemetry.RangesTree.Items.Where(Function(wr) wr.Id = Id).SingleOrDefault + If WorkerRange IsNot Nothing Then + _telemetry.RangesTree.Remove(WorkerRange) + End If + + Catch IOEx As InvalidOperationException + + ' This should not happen : more than one range with same id + ' To be safe just clear _telemetry.RangesTree and let + ' it be repopulated with Clients scheduled events + _telemetry.RangesTree.Clear() + + Catch ex As Exception + + ' This should not happen + ' Output to log + Logger.Log(0, String.Format("{0} unmanaged error: {1}", WorkerOrId, ex.GetBaseException.Message), _context) + + End Try + + End SyncLock + + If DisconnectedEvent IsNot Nothing Then RaiseEvent Disconnected(Me) + + End Sub + + ''' + ''' Handles the incoming message + ''' + ''' A Json object string + Private Sub ProcessMessage(message As String) + + ' Out message received + If _settings.LogVerbosity >= 9 Then Logger.Log(9, "<< " & message, _context) + + Dim jsonMsg As JsonObject = Nothing + Dim msgId As Integer = 0 + Dim msgMethod As String = String.Empty + Dim msgResult As Boolean = False + Dim msgError As String = String.Empty + + Try + + jsonMsg = JsonValue.Parse(message) + With jsonMsg + If .ContainsKey("id") Then .TryGetValue("id", msgId) + If .ContainsKey("method") Then .TryGetValue("method", msgMethod) + If .ContainsKey("error") Then .TryGetValue("error", msgError) + If .ContainsKey("result") Then .TryGetValue("result", msgResult) + End With + + Catch ex As Exception + + ' Invalid format of json + Logger.Log(0, String.Format("Json parse failed from worker {1} : {0}", ex.GetBaseException.Message, WorkerOrId), _context) + Return + + End Try + + + ' Handle message + Select Case True + + Case msgMethod = "mining.subscribe" + + ' Check is NOT mining.subscribe in NiceHash format + If jsonMsg.ContainsKey("params") Then + If jsonMsg("params").JsonType = JsonType.Array Then + If jsonMsg("params").ToString.IndexOf("EthereumStratum/") > 0 Then + _socket.Send(NewJsonRpcResErr(msgId, "Not implemented").ToString()) + Return + End If + End If + End If + + ' Accept mining subscription + _clientStatus.SetFlags({ClientStatus.Subscribed}) + _socket.Send(NewJsonRpcResOk(msgId).ToString) + Logger.Log(4, String.Format("{0} subscribed", RemoteEndPoint.ToString), _context) + + Case msgMethod = "mining.authorize" + + ' Authorization MUST come in one of these alternative ways + ' / To present the workername only + ' // To present the workername and the API port of ethminer + + Dim auth As String = jsonMsg("params").Item(0) + + If Not String.IsNullOrEmpty(auth.Trim()) Then + + Dim strPos As Integer = auth.IndexOf("/") + + If strPos < 0 Then + _socket.Send(NewJsonRpcResErr(msgId, "Invalid credentials : use /[/]").ToString()) + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Disconnect)) + Return + Else + auth = auth.Substring(strPos + 1) + End If + + Dim authParts As String() = auth.Trim.Split("/", StringSplitOptions.RemoveEmptyEntries) + If authParts.Length > 0 Then + For i As Integer = 0 To authParts.Length - 1 + Select Case i + Case 0 + ' Workername + If authParts(i) <> "." Then _workerName = authParts(i).Trim + Case 1 + ' Client's API port + Dim port As Integer = 0 + If Not Integer.TryParse(authParts(i).Trim, port) OrElse (port < 1 OrElse port > 65535) Then + Logger.Log(0, $"Worker {WorkerOrId} does not provide a valid API port", _context) + Else + _apiEndPoint = New IPEndPoint(_socket.RemoteEndPoint.Address, port) + End If + End Select + Next + End If + + End If + + ' Immediately send job if available + _clientStatus.SetFlags({ClientStatus.Authorized}) + If _poolmgr.CurrentJob IsNot Nothing Then + With _poolmgr.CurrentJob + PushJob(New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", Nothing), + New KeyValuePair(Of String, JsonValue)("method", "mining.notify"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray From { .Header, .Header, .Seed, .Target}) + }) + End With + End If + + + Logger.Log(4, String.Format("{0} authorized. Worker name {1} {2}", RemoteEndPoint.ToString, If(String.IsNullOrEmpty(_workerName), "[no-name]", _workerName), If(_ApiEndPoint Is Nothing, "", "Control port " & _ApiEndPoint.Port.ToString)), _context) + + ' Start talking to client's API interface + If ApiEndPoint IsNot Nothing Then + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 2), + New KeyValuePair(Of String, JsonValue)("method", "miner_ping") + } + SendAPIMessage(jReq.ToString) + + End If + + + Case msgMethod = "mining.submit" + + ' Prevent submission if not authorized + If Not IsAuthorized Then + If IsConnected Then + _socket.Send(NewJsonRpcResErr(msgId, "Not Authorized").ToString) + End If + Return + End If + + ' Sanity checks over solution submitted + ' Should I ? Would you really want to submit something wrong ? + ' If user has set ethminer with --noeval there is no need to + ' recheck here. + + ' Submit to pool & Aknowledge worker + LastSubmittedTimestamp = DateTime.Now + Interlocked.Increment(SolutionsSubmitted) + If (_poolmgr.SubmitSolution(jsonMsg, Me)) = 2 Then + Interlocked.Increment(KnownStaleSolutions) + End If + + + Case msgMethod = "eth_submitHashrate" + + ' Prevent proxying submission if client not authorized + ' to keep list of workers clean + If Not IsAuthorized OrElse _poolmgr.IsFeeOn Then Return + + ' Aknowledge to client - Is this really needed ? + ' Ethminer does not take any action on such a reply + '_socket.Send(NewJsonRpcResOk(msgId).ToString()) + + + ' Try to detect HashRate + Try + + HashRate = Convert.ToUInt64(jsonMsg("params").Item(0), fromBase:=16) + If HashRate > MaxHashRate Then MaxHashRate = HashRate + + Catch ex As Exception + + Logger.Log(0, WorkerOrId + " sent an invalid hashrate value : " + jsonMsg("params")(1).ToString, _context) + Return + + End Try + + ' Conditional log before calculating values + If _settings.LogVerbosity >= 5 Then + Logger.Log(5, String.Format("{0} Hashrate {1}", WorkerOrId, ScaleHashes(HashRate)), _context) + End If + + ' Report this client hashrate only if --report-workers is set + If (_settings.PoolsReportWorkerNames AndAlso _settings.PoolsReportHashRate) Then + + Dim jsonReq As JsonObject = NewJsonRpc(9) + jsonReq.AddRange({ + New KeyValuePair(Of String, JsonValue)("method", "eth_submitHashrate"), + New KeyValuePair(Of String, JsonValue)("worker", _workerName), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray From {jsonMsg("params").Item(0), jsonMsg("params")(1)}) + }) + + ' Send to pool + _poolmgr.SubmitHashrate(jsonReq) + + End If + + Case Else + + ' Any other not implemented (yet ?) + _socket.Send(NewJsonRpcResErr(msgId, String.Format("Method {0} not implemented", msgMethod)).ToString()) + + + End Select + + End Sub + + ''' + ''' Sends the specified message through the underlying socket + ''' + ''' + Public Sub Send(ByVal message As String) + If disposedValue Then Return + If _socket IsNot Nothing AndAlso _socket.IsConnected Then + _socket.Send(message) + End If + End Sub + + ''' + ''' Pushes Job from Pool to Client + ''' + ''' The object which raised the event + Public Sub PushJob(JsonJob As JsonObject) Handles _poolmgr.EventNewJobReceived + + If Not IsConnected OrElse Not IsAuthorized Then Return + _socket.Send(JsonJob) + + End Sub + +#End Region + +#Region " Async Socket Event Handlers" + + Private Sub OnSocketConnected(ByRef sender As AsyncSocket) Handles _socket.Connected + End Sub + + Private Sub OnSocketDisconnected(ByRef sender As AsyncSocket) Handles _socket.Disconnected + + Disconnect() + + End Sub + + Private Sub OnSocketMessageReceived(ByRef sender As AsyncSocket, ByVal message As String) Handles _socket.MessageReceived + ProcessMessage(message) + End Sub + +#End Region + +#Region " Api Methods" + + ''' + ''' Will start API connection on selected port + ''' + Private Sub StartApiConnection() + + If _ApiEndPoint Is Nothing Then + Return + End If + + Try + + If _apisocket Is Nothing Then + _apisocket = New AsyncSocket("Api") + _apisocket.Connect(_apiEndPoint) + Else + If _apisocket.IsConnected = False AndAlso _apisocket.IsPendingState = False Then + _apisocket.Connect(_ApiEndPoint) + End If + End If + + + Catch ex As Exception + + ' Object disposed or disposing + + End Try + + End Sub + + ''' + ''' Will stop API connection if any + ''' + Private Sub StopApiConnection() + + If _apisocket IsNot Nothing Then + + _apiMessagesQueue.Clear() + _apisocket.Disconnect() + + End If + + End Sub + + ''' + ''' Processes API responses + ''' + Private Sub ProcessAPIResponse(ByVal message As String) + + Dim jsonMsg As JsonObject = Nothing + Dim msgId As Integer = 0 + Dim msgResult As Boolean = False + Dim msgError As String = String.Empty + + Try + + jsonMsg = JsonValue.Parse(message) + With jsonMsg + If .ContainsKey("id") Then .TryGetValue("id", msgId) + If .ContainsKey("error") AndAlso .Item("error") IsNot Nothing Then + msgError = .Item("error").ToString + End If + If Not .ContainsKey("jsonrpc") Then Throw New Exception("Missing jsonrpc member") + If Not .Item("jsonrpc") = "2.0" Then Throw New Exception("Jsonrpc value mismatch") + End With + + Catch ex As Exception + + ' Invalid format of json + Logger.Log(0, String.Format("Api response parse from worker {1} : {0}", ex.GetBaseException.Message, WorkerOrId), _context) + Return + + End Try + + ' If any error in the processing of method then + ' abandon API session + If Not String.IsNullOrEmpty(msgError) Then + + ' The request returned error + ' So ethminer's version does not implement this method + ' Clear ApiEndPoint and Disconnect Client + Logger.Log(0, $"{WorkerOrId} does not support required API interface. Disconnecting ...", _context) + ApiEndPoint = Nothing + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Disconnect)) + Return + + End If + + + Select Case msgId + + Case 1 + + ' Response to miner_ping + ' Well actually not very much to do but as we're live + ' prepare a request to pull ScrambleInfo + If Not _apiScrambleInfoPending Then + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 2), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "miner_getscramblerinfo") + } + _apiScrambleInfoPending = True + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf SendAPIMessage), jReq.ToString) + End If + + Case 2 + + ' Response to miner_getscramblerinfo + + _apiScrambleInfoPending = False + Dim jResult As JsonObject = jsonMsg("result") + + Try + + Dim newScrambleInfo As New ClientScrambleInfo With { + .TimeStamp = DateTime.Now, + .NonceScrambler = jResult("noncescrambler"), + .GpuWidth = jResult("segmentwidth") + } + + For i As Integer = 0 To jResult("segments").Count - 1 + Dim newSegment As New ClientScrambleInfoSegment With { + .GpuIndex = jResult("segments")(i)("gpu"), + .SegmentStart = jResult("segments")(i)("start"), + .SegmentStop = jResult("segments")(i)("stop") + } + newScrambleInfo.Segments.Add(newSegment) + Next i + + ApiScrambleInfo = newScrambleInfo + + Catch ex As Exception + + Logger.Log(0, $"{WorkerOrId} Could not load miner_getscramblerinfo", _context) + Return + + End Try + + '' No checks on no fee + If App.Instance.Settings.NoFee = True Then Return + + '' Remove any previous segment registration from this worker + Dim WorkerRange As WorkerRangeItem + SyncLock _telemetry.Lock + + Try + + WorkerRange = _telemetry.RangesTree.Items.Where(Function(wr) wr.Id = Id).SingleOrDefault + If WorkerRange IsNot Nothing Then + _telemetry.RangesTree.Remove(WorkerRange) + End If + + Catch ex As Exception + + ' This should not happen as all workers have a unique id + ' TODO disconnect all workers and wait for their reconnection + + End Try + + ' Check if this worker's range overlaps with some other's + WorkerRange = New WorkerRangeItem With {.Id = Id, .Name = WorkerOrId, .Range = New Range(Of UInt64)(ApiScrambleInfo.ScrambleStart, ApiScrambleInfo.ScrambleStop)} + Dim OverlappingRanges As List(Of WorkerRangeItem) = _telemetry.RangesTree.Query(WorkerRange.Range).Where(Function(r) r.Id <> WorkerRange.Id).ToList() + If OverlappingRanges.Count > 0 Then + + For Each wr As WorkerRangeItem In OverlappingRanges + Logger.Log(1, $"{WorkerRange.Id} range overlaps with {wr.Id}", _context) + Next + Logger.Log(1, $"Shuffling {WorkerRange.Id} ...", _context) + + ' Prepare a request to shuffle ScrambleInfo + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 3), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "miner_shuffle") + } + SendAPIMessage(jReq.ToString) + + Else + + ' Save non overlapping range + _telemetry.RangesTree.Add(WorkerRange) + + End If + + End SyncLock + + Case 3 + + ' Response to miner_shuffle + ' As we're here the method replied successfully + ' so issue a new request for miner_getscramblerinfo + + If Not _apiScrambleInfoPending Then + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 2), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "miner_getscramblerinfo") + } + _apiScrambleInfoPending = True + SendAPIMessage(jReq.ToString) + End If + + Case 4 + + ' Response to miner_getstathr + _apiInfoPending = False + Dim jResult As JsonObject = jsonMsg("result") + Dim newClientInfo As New ClientInfo With { + .TimeStamp = DateTime.Now, + .HashRate = jResult("ethhashrate"), + .RunTime = jResult("runtime"), + .Version = jResult("version") + } + + Dim gpuCount As Integer = jResult("ethhashrates").Count + With newClientInfo + For i As Integer = 0 To gpuCount - 1 + + .HashRates.Add(jResult("ethhashrates")(i)) + .Fans.Add(jResult("fanpercentages")(i)) + .Temps.Add(jResult("temperatures")(i)) + .Powers.Add(jResult("powerusages")(i)) + + Next + .Solutions.Count = jResult("ethshares") + .Solutions.Invalid = jResult("ethinvalid") + .Solutions.Rejected = jResult("ethrejected") + End With + + ' Persist informations + ApiInfo = newClientInfo + + Case 5 + + ' Response to miner_setscramblerinfo + ' As we got here then result is success + ' if no other requests pending reissue info + ' about scrambler + If Not _apiScrambleInfoPending Then + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 2), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "miner_getscramblerinfo") + } + _apiScrambleInfoPending = True + SendAPIMessage(jReq.ToString) + End If + + + End Select + + + + End Sub + + ''' + ''' Sends a method request to client's API + ''' + ''' The message to be sent + Public Sub SendAPIMessage(message As String) + + ' Do not enter if not possible to communicate + If Not IsConnected OrElse _apiEndPoint Is Nothing Then Return + + _apiMessagesQueue.Enqueue(message) + If Not IsAPIConnected Then + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf StartApiConnection)) + Else + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf SendAPIMessageQueue)) + End If + + End Sub + + ''' + ''' Asyncronously flushes the queue of messages to client's API + ''' + Private Sub SendAPIMessageQueue() + + If _apisocket Is Nothing OrElse + _apisocket.IsConnected = False Then + Return + End If + + While Not _apiMessagesQueue.IsEmpty + Dim message As String = String.Empty + If _apiMessagesQueue.TryDequeue(message) Then + _apisocket.Send(message) + End If + End While + + End Sub + + ''' + ''' Checks the witdth of subsegments assigned to each + ''' gpu to find wheter or not it can be compacted + ''' + Private Sub CheckWorkerSegment() + + ' Process only if connected for more than 5 minutes + If ApiEndPoint Is Nothing OrElse + ConnectionDuration.TotalMinutes < 5 OrElse + App.Instance.Settings.NoFee Then + Return + End If + + If ApiInfo Is Nothing OrElse DateTime.Now.Subtract(ApiInfo.TimeStamp).TotalMinutes > 3 Then + If Not _apiInfoPending Then + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 4), + New KeyValuePair(Of String, JsonValue)("method", "miner_getstathr") + } + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf SendAPIMessage), jReq.ToString) + _apiInfoPending = True + End If + End If + + If ApiScrambleInfo Is Nothing OrElse DateTime.Now.Subtract(ApiScrambleInfo.TimeStamp).TotalMinutes > 3 Then + If Not _apiScrambleInfoPending Then + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 2), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "miner_getscramblerinfo") + } + _apiScrambleInfoPending = True + End If + End If + + ' Wait for next loop in case we need fresher informations + ' or not enough time to optimize segments + If _apiInfoPending OrElse + _apiScrambleInfoPending OrElse + App.Instance.PoolMgr.ConnectionDuration.TotalMinutes < 10 Then + Return + End If + + Try + + ' Analyze worker's segment and hashrate + Dim maxGPUHashratePerSecond As UInt64 = ApiInfo.HashRates.Max() + Dim avgJobInterval As Double = (_telemetry.MaxJobInterval / 1000) * 1.2 ' Apply 20% margin in excess + Dim maxGpuHashesPerJobInterval = (maxGPUHashratePerSecond * avgJobInterval) + Dim newSegmentWidth As Integer = Math.Round(Math.Log(maxGpuHashesPerJobInterval, 2)) + + ' As rounding may be done to lower integer apply further check + While Math.Pow(2, newSegmentWidth) < maxGpuHashesPerJobInterval + newSegmentWidth += 1 + End While + + ' We've got a new ideal segment width per gpu. Compare to current + ' and apply differences + If newSegmentWidth <> ApiScrambleInfo.GpuWidth Then + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 5), + New KeyValuePair(Of String, JsonValue)("method", "miner_setscramblerinfo"), + New KeyValuePair(Of String, JsonValue)("params", New JsonObject From { + New KeyValuePair(Of String, JsonValue)("segmentwidth", newSegmentWidth) + }) + } + ApiSegmentCheckedOn = DateTime.Now + SendAPIMessage(jReq.ToString) + + End If + + Catch ex As Exception + + End Try + + End Sub + +#End Region + +#Region " Async Api Socket Event Handlers" + + Private Sub OnApiSocketConnected(ByRef sender As AsyncSocket) Handles _apisocket.Connected + + ApiConnectionAttempts = 0 + sender.BeginReceive() + If _apiMessagesQueue.Count > 0 Then + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf SendAPIMessageQueue)) + End If + + End Sub + + Private Sub OnApiSocketConnectionFailed(ByRef sender As AsyncSocket) Handles _apisocket.ConnectionFailed + + ' Disconnect client after 5 failed connection attempts + Interlocked.Increment(ApiConnectionAttempts) + If ApiConnectionAttempts >= 4 Then + Logger.Log(1, $"Client {WorkerOrId} does not have a respondig API interface. Disconnecting.") + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Disconnect)) + End If + + End Sub + + Private Sub OnApiSocketDisconnected(ByRef sender As AsyncSocket) Handles _apisocket.Disconnected + + Logger.Log(3, String.Format("Client {0} API interface disconnected", WorkerOrId), _context) + + End Sub + + Private Sub OnApiSocketMessageReceived(ByRef sender As AsyncSocket, ByVal message As String) Handles _apisocket.MessageReceived + + ' Process the response + ProcessAPIResponse(message) + + End Sub + +#End Region + +#Region " Scheduler" + + ''' + ''' Performs scheduled tasks + ''' + Private Sub OnScheduleTimerElapsed() Handles _scheduleTimer.Elapsed + + If _scheduleRunning Then Return + _scheduleRunning = True + + ' ----------------------------------------------------------- + ' Check client isn't idle for more than 1 minute + ' ----------------------------------------------------------- + If IsConnected AndAlso IdleDuration.TotalMinutes > 1 Then + + ' Force disconnection + Logger.Log(1, String.Format("{0} has been idle for more than 1 minute. Disconnecting.", WorkerOrId), _context) + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Disconnect)) + _scheduleRunning = False + Return + + End If + + ' ----------------------------------------------------------- + ' Check API segment width and overlaps every 3 minutes + ' ----------------------------------------------------------- + If ApiScrambleInfo Is Nothing OrElse DateTime.Now.Subtract(ApiScrambleInfo.TimeStamp).TotalMinutes >= 3 Then + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf CheckWorkerSegment)) + Else + ' Disconnect API interface if idle for more than 15 seconds. + If _apisocket IsNot Nothing AndAlso _apisocket.IdleDuration.TotalSeconds >= 15 Then + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf StopApiConnection)) + End If + End If + + ' ----------------------------------------------------------- + ' Eventually resubmit scheduler + ' ----------------------------------------------------------- + With _scheduleTimer + .Interval = (GetRandom(1000, 3000) * 10) + .AutoReset = False + .Enabled = True + End With + + _scheduleRunning = False + + End Sub + +#Region " IDisposable Support" + + Private disposedValue As Boolean ' To detect redundant calls + + ' IDisposable + Protected Overridable Sub Dispose(disposing As Boolean) + If Not disposedValue Then + If disposing Then + + _socket.Dispose() + If _apisocket IsNot Nothing Then _apisocket.Dispose() + If _scheduleTimer IsNot Nothing Then _scheduleTimer.Dispose() + _poolmgr = Nothing + _clntmgr = Nothing + _telemetry = Nothing + _settings = Nothing + ApiInfo = Nothing + ApiScrambleInfo = Nothing + + End If + + ' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below. + ' TODO: set large fields to null. + End If + disposedValue = True + End Sub + + ' TODO: override Finalize() only if Dispose(disposing As Boolean) above has code to free unmanaged resources. + 'Protected Overrides Sub Finalize() + ' ' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above. + ' Dispose(False) + ' MyBase.Finalize() + 'End Sub + + ' This code added by Visual Basic to correctly implement the disposable pattern. + Public Sub Dispose() Implements IDisposable.Dispose + ' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above. + Dispose(True) + ' TODO: uncomment the following line if Finalize() is overridden above. + ' GC.SuppressFinalize(Me) + End Sub +#End Region + + +#End Region + + End Class + +End Namespace diff --git a/Clients/ClientInfo.vb b/Clients/ClientInfo.vb new file mode 100644 index 0000000..a5a6b23 --- /dev/null +++ b/Clients/ClientInfo.vb @@ -0,0 +1,75 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace Clients + + Public Class ClientInfo + + Public Property TimeStamp As DateTime + Public Property Version As String + Public Property RunTime As Long + Public Property HashRate As UInt64 = UInt64.MinValue + Public Property HashRates As New List(Of UInt64) + Public Property Fans As New List(Of Double) + Public Property Temps As New List(Of Double) + Public Property Powers As New List(Of Double) + Public Property Solutions As New ClientSolutionsInfo + + End Class + + Public Class ClientSolutionsInfo + + Public Property Count As Long + Public Property Invalid As Long + Public Property Rejected As Long + + End Class + + Public Class ClientScrambleInfo + + Public Property TimeStamp As DateTime + Public Property NonceScrambler As UInt64 = UInt64.MinValue + Public Property Segments As New List(Of ClientScrambleInfoSegment) + Public Property GpuWidth As UInteger + + Public ReadOnly Property ScrambleStart As UInt64 + Get + If Segments.Count = 0 Then Return UInt64.MinValue + Return Segments.First.SegmentStart + End Get + End Property + + Public ReadOnly Property ScrambleStop As UInt64 + Get + If Segments.Count = 0 Then Return UInt64.MinValue + Return Segments.Last.SegmentStop + End Get + End Property + + End Class + + Public Class ClientScrambleInfoSegment + + Public Property GpuIndex As UInteger + Public Property SegmentStart As UInt64 = UInt64.MinValue + Public Property SegmentStop As UInt64 = UInt64.MinValue + + End Class + +End Namespace diff --git a/Clients/ClientsManager.vb b/Clients/ClientsManager.vb new file mode 100644 index 0000000..34cd629 --- /dev/null +++ b/Clients/ClientsManager.vb @@ -0,0 +1,285 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports System.Net +Imports System.Net.Sockets +Imports System.Threading + +Namespace Clients + Public Class ClientsManager + +#Region " Fields" + + ' Ref to Singletons + Private _telemetry As Telemetry = App.Instance.Telemetry + Private _settings As Settings = App.Instance.Settings + Private _poolmgr As Pools.PoolManager = App.Instance.PoolMgr + + ' Logging context + Protected _context As String = "Proxy" + Protected Shared _lockObj As New Object + + ' This is server socket + Private _serverSocket As Socket + Private _isRunning As Boolean = False + + ' Here is our stack of available accept sockets + Protected _clientsList As New List(Of Client) + +#End Region + +#Region " Constructor" + + Public Sub New() + End Sub + +#End Region + +#Region " Properties" + + ''' + ''' Gets the list of connected clients + ''' + ''' + Public ReadOnly Property Clients As List(Of Client) + Get + Return _clientsList + End Get + End Property + +#End Region + +#Region " Methods" + + ''' + ''' Starts the server and begin listen for incoming connections + ''' + ''' True or False + Public Function Start() As Boolean + + Try + + _serverSocket = New Socket(_settings.ListenerEndPoint.AddressFamily, SocketType.Stream, ProtocolType.Tcp) + + ' Now make it a listener socket at the IP address and port that we specified + _serverSocket.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReuseAddress, 1) + _serverSocket.Bind(_settings.ListenerEndPoint) + + ' Now start listening on the listener socket and wait for asynchronous client connections + _serverSocket.Listen(Core.DEFAULT_MAX_CONNECTIONS) + Logger.Log(1, String.Format("Accepting client connections on {0}", _settings.ListenerEndPoint), _context) + + _isRunning = True + + ' Begin accepting connections asynchronously + StartAcceptClientAsync() + + Return True + + Catch ex As Exception + + Logger.Log(0, ex.GetBaseException.Message, _context) + Return False + + End Try + + + End Function + + ''' + ''' This method is called once to stop the server if it is started. + ''' + Public Sub [Stop]() + + _isRunning = False + + ' Close all clients + While _clientsList.Count > 0 + _clientsList(_clientsList.Count - 1).Disconnect() + End While + + If _serverSocket IsNot Nothing Then + Try + + _serverSocket.Shutdown(SocketShutdown.Both) + _serverSocket.Disconnect(True) + _serverSocket.Close() + _serverSocket.Dispose() + + Catch ex As Exception + + End Try + End If + + + End Sub + + ''' + ''' Processes the accept socket connection + ''' + ''' An object + Public Sub ProcessClientAccept(e As SocketAsyncEventArgs) + + ' First we get the accept socket from the passed in arguments + Dim acceptSocket As Socket = e.AcceptSocket + + ' If the accept socket is connected to a client we will process it + ' otherwise nothing happens + If acceptSocket.Connected Then + + + If _isRunning Then + + If _telemetry.ConnectedMiners >= DEFAULT_MAX_CONNECTIONS Then + + Logger.Log(1, String.Format("Connection request from {0} rejected: Too many clients [{1:N0}]", acceptSocket.RemoteEndPoint.ToString, _telemetry.ConnectedMiners), _context) + acceptSocket.Disconnect(False) + acceptSocket.Close() + + Else + + Try + + Logger.Log(1, String.Format("Connection request from {0}", acceptSocket.RemoteEndPoint.ToString), _context) + + ' Initialize a new client which will begin to receive + ' immediately + SyncLock _lockObj + + Dim newClient As New Client(e.AcceptSocket) + AddHandler newClient.Disconnected, AddressOf OnClientDisconnected + _clientsList.Add(newClient) + Interlocked.Increment(_telemetry.ConnectedMiners) + Logger.Log(6, String.Format("Total clients now {0}", _telemetry.ConnectedMiners), _context) + + End SyncLock + + Catch ex As Exception + + acceptSocket.Disconnect(False) + acceptSocket.Close() + Logger.Log(0, ex.GetBaseException.Message, _context) + + End Try + + ' Start the process again to wait for the next connection + StartAcceptClientAsync() + + + End If + + + Else + + Logger.Log(1, String.Format("Connection request from {0} rejected: Stopping ...", acceptSocket.RemoteEndPoint.ToString), _context) + acceptSocket.Disconnect(False) + acceptSocket.Close() + + End If + + + End If + + + End Sub + + ''' + ''' Gets overall hashrate + ''' + ''' A Decimal + Public Function GetTotalHashRate() As Decimal + Dim retVar As Decimal = Decimal.Zero + SyncLock _lockObj + retVar = _clientsList.Where(Function(c) c.IsConnected = True).Sum(Function(s) s.HashRate) + End SyncLock + Return retVar + End Function + + +#End Region + +#Region " Async Worker" + + ''' + ''' This method implements the asynchronous loop of events + ''' that accepts incoming client connections + ''' + Public Sub StartAcceptClientAsync(Optional e As SocketAsyncEventArgs = Nothing) + + If Not _isRunning Then Return + + ' If there is not an accept socket, create it + ' If there is, reuse it + If (e Is Nothing) Then + e = New SocketAsyncEventArgs() + AddHandler e.Completed, AddressOf OnClientAcceptCompleted + Else + e.AcceptSocket = Nothing + End If + + ' If there are no connections waiting to be processed then we can go ahead and process the accept. + ' Otherwise, the Completed event we tacked onto the accept socket will do it when it completes + If Not (_serverSocket.AcceptAsync(e)) Then + ProcessClientAccept(e) + End If + + End Sub + + +#End Region + +#Region " Events Handlers" + + ''' + ''' Handles acceptance of new client socket + ''' + Private Sub OnClientAcceptCompleted(sender As Object, e As SocketAsyncEventArgs) + + If (e Is Nothing OrElse (e.SocketError <> SocketError.Success)) Then Return + ProcessClientAccept(e) + + End Sub + + ''' + ''' Handles client disconnection + ''' + ''' The disconnected client + Public Sub OnClientDisconnected(ByRef sender As Client) + + RemoveHandler sender.Disconnected, AddressOf OnClientDisconnected + SyncLock _lockObj + _clientsList.Remove(sender) + End SyncLock + + Interlocked.Decrement(_telemetry.ConnectedMiners) + + Logger.Log(3, String.Format("{0} disconnected", sender.WorkerOrId), _context) + Logger.Log(6, String.Format("Total clients now {0}", _telemetry.ConnectedMiners), _context) + sender.Dispose() + + End Sub + + +#End Region + + + End Class + +End Namespace \ No newline at end of file diff --git a/Core/App.vb b/Core/App.vb new file mode 100644 index 0000000..212e901 --- /dev/null +++ b/Core/App.vb @@ -0,0 +1,123 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace Core + + Public NotInheritable Class App + + Public Property StartTime As DateTime = DateTime.Now + +#Region " Singletons" + + Private Shared ReadOnly _instance As App = New App + + Private _settings As Settings + Private _telemetry As Telemetry + Private _poolmgr As Pools.PoolManager + Private _clntmgr As Clients.ClientsManager + Private _apimgr As Api.ApiServer + + Private _eventsStack As AsyncEventArgsConcurrentStack + + Shared Sub New() + End Sub + + Private Sub New() + End Sub + + Public Sub Init() + + _settings = New Settings + _telemetry = New Telemetry + _poolmgr = New Pools.PoolManager + _clntmgr = New Clients.ClientsManager + + End Sub + + Public Shared ReadOnly Property Instance As App + Get + Return _instance + End Get + End Property + + Public ReadOnly Property Settings As Settings + Get + Return _settings + End Get + End Property + + Public ReadOnly Property Telemetry As Telemetry + Get + Return _telemetry + End Get + End Property + + Public ReadOnly Property PoolMgr As Pools.PoolManager + Get + Return _poolmgr + End Get + End Property + + Public ReadOnly Property ClntMgr As Clients.ClientsManager + Get + Return _clntmgr + End Get + End Property + + Public ReadOnly Property ApiMgr As Api.ApiServer + Get + Return _apimgr + End Get + End Property + +#End Region + +#Region " Methods" + + Public Sub Start() + + _telemetry.StartWorking() + _poolmgr.Start() + _clntmgr.Start() + + ' Start Api server if needed + If _settings.ApiListenerEndPoint IsNot Nothing Then + _apimgr = New Api.ApiServer + _apimgr.Start() + End If + + End Sub + + Public Sub [Stop]() + + If _apimgr IsNot Nothing Then _apimgr.Stop() + + _telemetry.StopWorking() + _clntmgr.Stop() + _poolmgr.Stop() + + End Sub + +#End Region + + End Class + + + +End Namespace diff --git a/Core/Donate.vb b/Core/Donate.vb new file mode 100644 index 0000000..57d6c16 --- /dev/null +++ b/Core/Donate.vb @@ -0,0 +1,46 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace Core + + Partial Public Module Helpers + + ''' + ''' Defines the donation % + ''' + ''' + ''' + ''' Default level is 0.75% this means that every 100 minutes + ''' of connection to pool 45 seconds will be dedicated to + ''' devfee + ''' + ''' If you plan to set this value to 0 please consider you're + ''' making me loose any revenue from my work. + ''' + ''' If you wish to donate directly here are my donation addresses + ''' + ''' Ethereum 0x9E431042fAA3224837e9BEDEcc5F4858cf0390B9 + ''' Ethereum Classic 0x6e4Aa5064ced1c0e9E20A517B9d7A7dDe32A0dcf + ''' + ''' + Public Const DONATE_LEVEL As Double = 0.75 / 100 + + End Module + +End Namespace diff --git a/Core/Extensions.vb b/Core/Extensions.vb new file mode 100644 index 0000000..abe77ee --- /dev/null +++ b/Core/Extensions.vb @@ -0,0 +1,136 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports System.Runtime.CompilerServices + +Namespace Core + Module Extensions + +#Region " Enums" + + ''' + ''' Flags setter for Enum + ''' + + Public Function SetFlags(ByRef value As [Enum], ParamArray flags() As [Enum]) As [Enum] + + If flags.Length Then + For Each flag In flags + value = value Or CObj(flag) + Next + End If + Return value + + End Function + + ''' + ''' Flags unsetter for Enum + ''' + + Public Function UnsetFlags(ByRef value As [Enum], ParamArray flags() As [Enum]) As [Enum] + + If flags.Length Then + For Each flag In flags + value = value And Not CObj(flag) + Next + End If + Return value + + End Function + + ''' + ''' Flags checker for Enum + ''' + + Public Function HasFlags(value As [Enum], ParamArray flags() As [Enum]) As Boolean + + If flags.Length Then + For Each flag In flags + If Not value.HasBitFlag(flag) Then Return False + Next + Return True + Else + Return False + End If + + End Function + + ''' + ''' Flags checker for Enum + ''' + + Public Function HasAnyFlag(value As [Enum], ParamArray flags() As [Enum]) As Boolean + + If flags.Length Then + For Each flag In flags + If value.HasBitFlag(flag) Then Return True + Next + Return False + Else + Return False + End If + + End Function + + + + Public Function HasBitFlag(value As [Enum], flag As [Enum]) As Boolean + Return ((value And CObj(flag)) = flag) + End Function + + + ''' + ''' Gets whether or not a give jsonvalue is empty + ''' + ''' + ''' + + Public Function Empty(value As Json.JsonValue) As Boolean + + If value Is Nothing Then Return True + Select Case value.JsonType + Case Json.JsonType.String + Return String.IsNullOrEmpty(value) + Case Json.JsonType.Array + Return value.Count = 0 + Case Json.JsonType.Object + Return value.ToString = """{}""" + Case Else + Return False + End Select + + End Function + + ''' + ''' Restarts a timer + ''' + ''' + + Public Sub Reset(ByRef value As Timers.Timer) + + value.Stop() + value.Start() + + End Sub + +#End Region + + End Module + +End Namespace diff --git a/Core/Helpers.vb b/Core/Helpers.vb new file mode 100644 index 0000000..2fab5b4 --- /dev/null +++ b/Core/Helpers.vb @@ -0,0 +1,555 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports System.Net +Imports System.Numerics +Imports System.Json +Imports System.Text.RegularExpressions + +Namespace Core + + Partial Public Module Helpers + +#Region " Constants" + + ''' + ''' Defines the default size for send/receive buffers + ''' + Public Const DEFAULT_BUFFER_SIZE As Integer = 256 + + ''' + ''' Defines the default number of sockets to add + ''' to the stack when no available + ''' + Public Const DEFAULT_SOCKET_STACK_INCREASE As Integer = 16 + + ''' + ''' Sets the max backlog for pending connections + ''' + Public Const DEFAULT_MAX_CONNECTIONS As Integer = 32000 + +#End Region + +#Region " Enums" + + ''' + ''' Statuses of async TCP connections + ''' + + Public Enum AsyncSocketStatus + + NotConnected = 1 << 0 + Connecting = NotConnected << 1 + Connected = Connecting << 1 + Disconnecting = Connected << 1 + + End Enum + + ''' + ''' Status of Pool connection (application level) + ''' + + Public Enum PoolStatus + + NotConnected = 1 << 0 + Connected = NotConnected << 1 + Subscribed = Connected << 1 + Authorized = Subscribed << 1 + + End Enum + + ''' + ''' Status of Client connection (application level) + ''' + + Public Enum ClientStatus + + NotConnected = 1 << 0 + Connected = NotConnected << 1 + Subscribed = Connected << 1 + Authorized = Subscribed << 1 + ApiAvailable = Authorized << 1 + ApiConnected = ApiAvailable << 1 + + End Enum + + ''' + ''' Enumeration of stratum modes + ''' + Public Enum StratumModeEnum + + Undefined + TentativeStratum + TentativeEthProxy + Stratum + Ethproxy + + End Enum + + ''' + ''' Define Application Exit Codes + ''' + Public Enum ExitCodes + + Success = 0 + ArgumentsError = 1 + + End Enum + +#End Region + + ''' + ''' Returns a human readable value for hashes scaled to the + ''' next unit which is lower than 10^3 + ''' + ''' + ''' A string + Public Function ScaleHashes(ByVal hashSample As Double) As String + + Static units As String() = {"h", "Kh", "Mh", "Gh", "Th", "Ph"} + Static unitIdx As Integer = 0 + + unitIdx = 0 + Do + If hashSample < 1000 OrElse unitIdx = units.Length - 1 Then + Return String.Format("{0:N2} {1}", hashSample, units(unitIdx)) + End If + hashSample = hashSample / 1000 + unitIdx += 1 + Loop + + End Function + + ''' + ''' Gets Developer Donation addresses + ''' + ''' + Public Function GetFeeAddresses() As Dictionary(Of String, String) + Static retvar As Dictionary(Of String, String) = New Dictionary(Of String, String) From { + {"eth", "0x9E431042fAA3224837e9BEDEcc5F4858cf0390B9"}, + {"etc", "0x6e4Aa5064ced1c0e9E20A517B9d7A7dDe32A0dcf"} + } + Return retvar + End Function + + ''' + ''' Gets the DevFeeAddress + ''' + ''' + ''' + Public Function GetDevAddress(fromHost As String) As String + + Dim PoolName As String = String.Empty + Dim PoolPort As Integer = 0 + + If String.IsNullOrEmpty(fromHost) Then Return String.Empty + If fromHost.IndexOf(":", 0) < 0 Then Return String.Empty + + PoolName = fromHost.Split(":", StringSplitOptions.RemoveEmptyEntries)(0) + PoolPort = CInt(fromHost.Split(":", StringSplitOptions.RemoveEmptyEntries)(1)) + + + Select Case True + + Case PoolName.EndsWith("2miners.com") + + Dim dashPos As Integer = PoolName.LastIndexOf("-", 0) + Dim coinTicker As String = PoolName.Substring(dashPos + 1) + Try + Return GetFeeAddresses(coinTicker) + Catch ex As Exception + Return String.Empty + End Try + + Case PoolName.EndsWith("dwarfpool.com") + + Dim dashPos As Integer = PoolName.IndexOf("-", 0) + If dashPos > 2 Then + Try + Dim coinTicker As String = PoolName.Substring(0, dashPos) + Return GetFeeAddresses(coinTicker) + Catch ex As Exception + Return String.Empty + End Try + Else + Return String.Empty + End If + + Case PoolName.EndsWith("ethermine.org") + + If PoolName.Split(".", StringSplitOptions.RemoveEmptyEntries)(0).EndsWith("etc") Then + Return GetFeeAddresses("etc") + End If + Return GetFeeAddresses("eth") + + Case PoolName.EndsWith("ethpool.org") + + Return GetFeeAddresses("eth") + + Case PoolName.EndsWith("f2pool.com") + + Dim coinTicker As String = PoolName.Split(".", StringSplitOptions.RemoveEmptyEntries)(0) + Try + Return GetFeeAddresses(coinTicker) + Catch ex As Exception + Return String.Empty + End Try + + Case PoolName.EndsWith("miningpoolhub.com") + + Select Case PoolPort + Case 20535 + Return GetFeeAddresses("eth") + Case 20555 + Return GetFeeAddresses("etc") + End Select + + Case PoolName.EndsWith("nanopool.org") + + Dim dashPos As Integer = PoolName.IndexOf("-", 0) + If dashPos > 2 Then + Try + Dim coinTicker As String = PoolName.Substring(0, dashPos) + Return GetFeeAddresses(coinTicker) + Catch ex As Exception + Return String.Empty + End Try + Else + Return String.Empty + End If + + Case PoolName.EndsWith("sparkpool.com") + + Return GetFeeAddresses("eth") + + End Select + + Return String.Empty + + End Function + + ''' + ''' Calculates difficulty + ''' + ''' + ''' + Public Function GetDiffToTarget(ByVal inputHex As String) As Double + + Static diffDividend As BigInteger = BigInteger.Zero + If diffDividend = BigInteger.Zero Then diffDividend = BigInteger.Parse("10000000000000000000000000000000000000000000000000000000000000000", Globalization.NumberStyles.AllowHexSpecifier, Nothing) + + Dim diffDivisor As BigInteger = BigInteger.Zero + If inputHex.StartsWith("0x") Then + inputHex = inputHex.Substring(2) + End If + If BigInteger.TryParse(inputHex, Globalization.NumberStyles.AllowHexSpecifier, Nothing, diffDivisor) Then + Return (diffDividend / diffDivisor) + End If + Return 0 + + End Function + + ''' + ''' Transforms any hexadecimal string into a fixed length 66 chars + ''' + ''' A hexadecimal string + ''' + Public Function H66(value As String) As String + + Dim retVar As BigInteger = BigInteger.Zero + If value.StartsWith("0x") Then + value = value.Substring(3) + End If + If BigInteger.TryParse(value, Globalization.NumberStyles.AllowHexSpecifier, Nothing, retVar) Then + Return String.Format("0x{0:x64}", retVar) + End If + Return String.Empty + + End Function + + ''' + ''' Returns an array of integers from a comma separated string. + ''' + ''' + ''' + Public Function PortsFromString(stringPorts As String) As Integer() + + If stringPorts = String.Empty Then Return Nothing + Dim stringValues As String() = stringPorts.Split(",") + Dim intValues(stringValues.Length) As Integer + For i As Integer = 0 To stringValues.Length - 1 + intValues(i) = Integer.Parse(stringValues(i)) + Next + Return intValues + + End Function + + ''' + ''' Whether or not the given name is a valid HostName + ''' + ''' The string to check + ''' + Public Function IsValidHostName(inputString As String) As Boolean + + Static rgxValidHostname As Regex = Nothing + If rgxValidHostname Is Nothing Then rgxValidHostname = New Regex("^(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z]|[A-Za-z][A-Za-z0-9\-]*[A-Za-z0-9])$", RegexOptions.IgnoreCase) + Return rgxValidHostname.IsMatch(inputString) + + End Function + + ''' + ''' Returns wether or not the inputString matches a valid hexadecimal of 64 bytes + ''' + ''' The string to be checked + ''' True or False + Public Function IsHex64(inputString As String) As Boolean + + Static rgxValidHex64 As New Regex("^([a-f0-9]{64})$", RegexOptions.IgnoreCase) + Return rgxValidHex64.IsMatch(inputString) + + End Function + + ''' + ''' Gets wether or not the given input string is an IpV4 address + ''' + ''' The string to be checked + ''' + Public Function IsIPAddressV4(input As String) As Boolean + + Dim _ipAddress As IPAddress = Nothing + If IPAddress.TryParse(input, _ipAddress) Then + Return _ipAddress.AddressFamily = Net.Sockets.AddressFamily.InterNetwork + End If + Return False + + End Function + + ''' + ''' Gets wether or not the given input string is an IpV4 address + ''' + ''' The string to be checked + ''' + Public Function IsIPAddressV6(input As String) As Boolean + + Dim _ipAddress As IPAddress = Nothing + If IPAddress.TryParse(input, _ipAddress) Then + Return _ipAddress.AddressFamily = Net.Sockets.AddressFamily.InterNetworkV6 + End If + Return False + + End Function + + ''' + ''' Creates an IPEndPoint from given address of host and port + ''' + ''' A string for an hostname or ip address + ''' The port number for the socket + ''' An object + Public Function CreateIPEndPoint(host As String, port As Integer) As IPEndPoint + + Dim _ipAddress As IPAddress = Nothing + + ' Prevent resolve if not needed + If IsIPAddressV4(host) OrElse IsIPAddressV6(host) Then + + _ipAddress = IPAddress.Parse(host) + + Else + + Dim hostInfo As IPHostEntry = Dns.GetHostEntry(host) + _ipAddress = hostInfo.AddressList(0) + + End If + + Return New IPEndPoint(_ipAddress, port) + + + End Function + + + ''' + ''' Returns a pseudo-random value among the given range + ''' + Public Function GetRandom(ByVal minValue As Integer, ByVal maxValue As Integer) As Integer + + ' Static prevents same seed generation + Static rndGenerator As Random = New Random() + Return rndGenerator.Next(minValue, maxValue) + + End Function + + ''' + ''' App title + ''' + ''' A string + Public Function GetTitle() As String + + Static retVar As String = " + _ _ ____ ____ _ _ ____ ____ _____ _ _ _ _ + ( \( )( ___)(_ _)( )_( ) ___ ( _ \( _ \( _ )( \/ )( \/ ) + ) ( )__) )( ) _ ( (___) )___/ ) / )(_)( ) ( \ / + (_)\_)(____) (__) (_) (_) (__) (_)\_)(_____)(_/\_) (__) + + Yet another stratum proxy proudly written for .Net Core + Release : " + GetType(Program).Assembly.GetName().Version.ToString() + ChrW(10) + + Return retVar + + End Function + + ''' + ''' Help text + ''' + ''' + Public Function GetHelpText() As String + + Static retVar As String = " +Usage : dotnet neth-proxy.dll + +Where are : (switches among square brackets are optional) + + -b | --bind [:] + -ab | --api-bind [:] + -sp | --stratum-pool [][:][.]@:[,] + [-np | --no-probe ] + [-wt | --work-timeout ] + [-rt | --response-timeout ] + [-rh | --report-hashrate ] + [-rw | --report-workkers ] + [-ws | --workers-spacing ] + [-ns | --no-stats] + [-si | --stats-interval ] + [-nc | --no-console] + [-nf | --no-fee] + [-ll | --log-level <0-9>] + [-h | --help ] + +Description of arguments +----------------------------------------------------------------------------------------------------------------------- +-b | --bind Sets the LOCAL address this proxy has to listen for incoming connections. + Default is any local address port 4444 +-ab | --api-bind Sets the LOCAL address this proxy has to listen for incoming connections on API interface. + Default is not enabled. +-sp | --stratum-pool Is the connection to the target pool this proxy has to forward workers +-np | --no-probe By default before connection to the pool each ip address bound to the hostname is pinged to determine + which responds faster. If you do not want to probe all host's ip then set this switch +-wt | --work-timeout Sets the number of seconds within each new work from the pool must come in. If no work within this number + of seconds the proxy disconnects and reconnects to next ip or next pool. Default is 120 seconds +-rt | --response-timeout Sets the time (in milliseconds) the pool should reply to a submission request. Should the response + exceed this amount of time then proxy will reconnect to other ip or other pool. + Default is 2000 (2 seconds) +-rh | --report-hashrate Submit hashrate to pool for each workername. Implies --report-workers +-rw | --report-workers Forward separate workernames to pool +-ws | --workers-spacing Sets the exponent in the power of 2 which expresses the spacing among workers segments + Default is 24 which means 2^24 nonces will be the minimum space among workers segments +-si | --stats-interval Sets the interval for stats printout. Default is 60 seconds. Min is 10 seconds. Set it to 0 to + disable stats printout completely. +-nc | --no-console Prevents reading from console so you can launch neth-proxy with output redirection to file +-nf | --no-fee Disables developer fee (0.75%). I will loose all my revenues but proxy won't do some optimization tasks. +-ll | --log-level Sets log verbosity 0-9. Default is 4 +-h | --help Prints this help message + +How to connect your ethminer's instances to this proxy +----------------------------------------------------------------------------------------------------------------------- +ethminer 0.15.rc2 is minimum version required with API support enabled + +ethminer -P stratum+tcp://:// --api-port + +where is the API port ethminer is listening on + +" + Return retVar + + + End Function + + Public Async Function WaitNetworkAvailable() As Task + + ' Check available ping against Google public DNS + Dim pingQry As NetworkInformation.Ping = New NetworkInformation.Ping() + Dim pingRep As NetworkInformation.PingReply + Dim googleAddress As IPAddress = IPAddress.Parse("8.8.8.8") + + Do + Try + pingRep = Await pingQry.SendPingAsync(address:=googleAddress, timeout:=1000) + Return + Catch ex As Exception + Logger.Log(0, "Internet not available. Waiting 3 seconds ...") + Threading.Thread.Sleep(3000) + End Try + Loop + + End Function + +#Region " Json Helpers" + + Public Function NewJsonRpc() As JsonObject + + Return New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0") + } + + End Function + + Public Function NewJsonRpc(id As Integer) As JsonObject + + Return New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", id), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0") + } + + End Function + + Public Function NewJsonRpc(id As Integer, method As String) As JsonObject + + Return New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", id), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", method) + } + + End Function + + Public Function NewJsonRpcResOk(id As Integer) + + Return New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", id), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("result", True) + } + + End Function + + Public Function NewJsonRpcResErr(ByVal id As Long, ByVal errText As String) As Json.JsonObject + + Return New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", id), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("result", False), + New KeyValuePair(Of String, JsonValue)("error", errText) + } + + End Function + +#End Region + + End Module + +End Namespace diff --git a/Core/Job.vb b/Core/Job.vb new file mode 100644 index 0000000..0a86594 --- /dev/null +++ b/Core/Job.vb @@ -0,0 +1,61 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace Core + + ''' + ''' Abstraction of a job received from pool + ''' + Public Class Job + + Public Property TimeStamp As DateTime = DateTime.Now + Public Property Header As String + Public Property Seed As String + Public Property Target As String + + Public ReadOnly Property Id + Get + Return Header.Substring(2, 8) + End Get + End Property + + Public Sub New() + End Sub + + Public Sub New(arr As Json.JsonArray, mode As StratumModeEnum) + + If mode = StratumModeEnum.Ethproxy Then + + Header = arr(0) + Seed = arr(1) + Target = arr(2) + + ElseIf mode = StratumModeEnum.Stratum Then + + Header = arr(1) + Seed = arr(2) + Target = arr(3) + + End If + + End Sub + + End Class + +End Namespace diff --git a/Core/Settings.vb b/Core/Settings.vb new file mode 100644 index 0000000..6ab3d01 --- /dev/null +++ b/Core/Settings.vb @@ -0,0 +1,89 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace Core + + ''' + ''' Holds the whole set of settings + ''' + Public Class Settings + +#Region " Fields" + + ' Pools + Public Property PoolsNoProbe As Boolean + Public Property PoolsWorkTimeout As Integer ' Default 120 seconds. If no work within this time then close connection and try another + Public Property PoolsResponseTimeout As Integer ' Default 2000 ms response time to submissions of shares + Public Property PoolsReportHashRate As Boolean ' Whether or not to report hash rate to pools + Public Property PoolsReportWorkerNames As Boolean ' Whether or not to report single workers names to pools + Public Property PoolsStratumLogin As String ' Default stratum login + Public Property PoolsStratumPassword As String ' Default stratum password + Public Property PoolsStratumWorker As String ' Default stratum worker name + Public Property PoolsMaxConnectionErrors As Integer ' Max number of connection errors allowed before switching pool + + ' Segments spacing + Public Property WorkersSpacing As Integer = 24 ' This is the exponent of 2 which spaces workers segments + + ' Server listener + Public Property ListenerEndPoint As Net.IPEndPoint ' The endpoint this proxy server is listening on + Public Property ApiListenerEndPoint As Net.IPEndPoint ' The endpoint this api server is listening on + + ' Statistics + Public Property StatsEnabled As Boolean = True ' Display statistics + Public Property StatsInterval As Integer ' Default 60 seconds for output stats + + ' Misc + Public Property NoConsole As Boolean ' Whether or not to respond to interactive console + Public Property LogVerbosity As Integer ' Log Verbosity level + Public Property NoFee As Boolean = False ' Whether the user decides to pay no fees. If true then no checking for overlapping ranges nor segment compact + + +#End Region + +#Region " Contructor" + + Public Sub New() + + StatsInterval = 60 + + ListenerEndPoint = New Net.IPEndPoint(Net.IPAddress.Any, 4444) ' Default + + ' Defaults for pools + PoolsNoProbe = False + PoolsWorkTimeout = 120 ' Seconds + PoolsResponseTimeout = 2000 ' Milliseconds + PoolsReportHashRate = False + PoolsReportWorkerNames = False + PoolsMaxConnectionErrors = 5 + + PoolsStratumLogin = String.Empty + PoolsStratumPassword = "x" + PoolsStratumWorker = String.Empty + + ' Misc + NoConsole = False + LogVerbosity = 4 + + End Sub + +#End Region + + End Class + +End Namespace \ No newline at end of file diff --git a/Core/SlidingQueue.vb b/Core/SlidingQueue.vb new file mode 100644 index 0000000..beb76e7 --- /dev/null +++ b/Core/SlidingQueue.vb @@ -0,0 +1,55 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace Core + + Public Class SlidingQueue(Of T) + + Private _maxCapacity As Integer + Private _queue As Concurrent.ConcurrentQueue(Of T) + + Public Sub New(capacity As Integer) + _maxCapacity = capacity + _queue = New Concurrent.ConcurrentQueue(Of T) + End Sub + + Public Sub Enqueue(item As T) + _queue.Enqueue(item) + While _queue.Count > _maxCapacity + Dim dummy As T + _queue.TryDequeue(dummy) + End While + End Sub + + Public Sub Clear() + _queue.Clear() + End Sub + + Public Function Contains(ByVal item As T) As Boolean + Return _queue.Contains(item) + End Function + + Public Function AsEnumerable() As IEnumerable(Of T) + Return _queue.AsEnumerable + End Function + + End Class + +End Namespace + diff --git a/Core/SocketStack.vb b/Core/SocketStack.vb new file mode 100644 index 0000000..7a7483c --- /dev/null +++ b/Core/SocketStack.vb @@ -0,0 +1,93 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports System.Collections.Concurrent +Imports System.Net.Sockets + +Namespace Core + + ''' + ''' Standard Stack implementation for reusable sockets + ''' + Public Class AsyncEventArgsConcurrentStack + + Private _stack As New ConcurrentStack(Of SocketAsyncEventArgs) + +#Region " Properties" + + Public ReadOnly Property Count As Integer + Get + Return _stack.Count + End Get + End Property + + Public ReadOnly Property IsEmpty As Boolean + Get + Return _stack.IsEmpty + End Get + End Property + +#End Region + +#Region " Methods" + + ''' + ''' Returns the enumerator of the stack + ''' + ''' + Public Function GetEnumerator() As IEnumerator(Of SocketAsyncEventArgs) + + Return _stack.GetEnumerator() + + End Function + + + ''' + ''' Pops an item off the top of the stack + ''' + ''' + Public Function Pop() As SocketAsyncEventArgs + + Dim item As SocketAsyncEventArgs = Nothing + If Not _stack.TryPop(item) Then + item = New SocketAsyncEventArgs + End If + Return item + + End Function + + ''' + ''' Pushes an item on the top of the stack + ''' + ''' + Public Sub Push(item As SocketAsyncEventArgs) + + If item Is Nothing Then + Throw New ArgumentNullException("Cannot add null item to the stack") + End If + _stack.Push(item) + + End Sub + +#End Region + + + End Class + +End Namespace \ No newline at end of file diff --git a/Core/Telemetry.vb b/Core/Telemetry.vb new file mode 100644 index 0000000..2ba6ad5 --- /dev/null +++ b/Core/Telemetry.vb @@ -0,0 +1,302 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.RangeTree +Imports System.Json +Imports System.Numerics + + +Namespace Core + + Public Class Telemetry + Inherits Worker + + Public Lock As New Object + +#Region " Public Fields" + + Public Property AppStartTime As DateTime = DateTime.Now ' Instance start time + Public Property DonationDuration As Long = 0 ' Overall donation duration in seconds + Public Property ConnectedMiners As Integer = 0 ' Overall number of connected Miners + Public Property TotalJobsReceived As Long = 0 ' Overall number of received jobs + Public Property TotalSolutionsSubmitted As Long = 0 ' Overall Number of Submitted sols + Public Property TotalSolutionsAccepted As Long = 0 ' Overall Number of Accepted sols + Public Property TotalSolutionsRejected As Long = 0 ' Overall Number of Rejected sols + Public Property TotalKnownStaleSolutions As Long = 0 ' Overall Number of Known Stale Solutions + Public Property MaxJobInterval As Double ' Max Job Interval in milliseconds + Public Property TotalPoolSwitches As Integer = 0 ' How many times have switched pool + Public Property TotalPoolConnectionAttempts As Long = 0 ' How many connection attempts to pool + Public Property TotalPoolConnectionFailed As Long = 0 ' How many connections to pool failed + +#End Region + +#Region " Private members" + + Private _tmrStatsDisplay As Threading.Timer + Private _tmrOptiSegments As Threading.Timer + Private _hashRate As Decimal = Decimal.Zero ' Store HashRate + + Private _responseTimes As New SlidingQueue(Of Double)(50) ' Keep last 50 response to submission times to calculate avg (in ms) + + ' This is the ranges tree to check for intersections + Private _fullRange As New WorkerRangeItem With {.Id = "root", .Range = New Range(Of UInt64)(UInt64.MinValue, UInt64.MaxValue)} + Private _rangesTree As New RangeTree(Of UInt64, WorkerRangeItem)(New WorkerRangeItemComparer) + +#End Region + +#Region " Properties" + + ''' + ''' Gets the avg number of seconds which elapse from one job to another + ''' + ''' A double + Public ReadOnly Property AvgJobInterval As Double + Get + If TotalJobsReceived = 0 Then Return 0 + Return DateTime.Now.Subtract(AppStartTime).TotalSeconds / TotalJobsReceived + End Get + End Property + + ''' + ''' Gets access to the queue of response times + ''' + ''' + Public ReadOnly Property ResponseTimes As SlidingQueue(Of Double) + Get + Return _responseTimes + End Get + End Property + + ''' + ''' Returns the average response time to submissions + ''' + ''' + Public ReadOnly Property AvgResponseTime As Double + Get + Return _responseTimes.AsEnumerable.Average() + End Get + End Property + + ''' + ''' Returns the overall hashrate + ''' + ''' + Public ReadOnly Property HashRate As Decimal + Get + Try + _hashRate = App.Instance.ClntMgr.GetTotalHashRate() + Catch ex As Exception + ' May fail due to modified collection + End Try + Return _hashRate + End Get + End Property + + ''' + ''' Gets the ranges tree + ''' + ''' + Public ReadOnly Property RangesTree As RangeTree(Of UInt64, WorkerRangeItem) + Get + Return _rangesTree + End Get + End Property + +#End Region + +#Region " Contructor" + + Public Sub New() + End Sub + + Public Overrides Sub StartWorking() + + MyBase.StartWorking() + + ' Should stats be displayed ? + If App.Instance.Settings.StatsEnabled Then + _tmrStatsDisplay = New Threading.Timer(New Threading.TimerCallback(AddressOf StatsDisplayCallBack), Nothing, App.Instance.Settings.StatsInterval * 1000, App.Instance.Settings.StatsInterval * 1000) + End If + + ' Start worker for segment optim + If App.Instance.Settings.NoFee = False Then + _tmrOptiSegments = New Threading.Timer(New Threading.TimerCallback(AddressOf OptiSuperSegmentCallBack), Nothing, 10000, 10000) + End If + + End Sub + + Public Overrides Sub StopWorking() + + MyBase.StopWorking() + + If _tmrStatsDisplay IsNot Nothing Then _tmrStatsDisplay.Dispose() + If _tmrOptiSegments IsNot Nothing Then _tmrOptiSegments.Dispose() + + End Sub + +#End Region + +#Region " Properties" + + Public ReadOnly Property AppDurationTime As TimeSpan + Get + Return DateTime.Now.Subtract(AppStartTime) + End Get + End Property + + Public ReadOnly Property StalePercent As Double + Get + If TotalSolutionsSubmitted = 0 Then Return 0 + Return (TotalKnownStaleSolutions / TotalSolutionsSubmitted) * 100 + End Get + End Property + + Public ReadOnly Property RejectPercent As Double + Get + If TotalSolutionsSubmitted = 0 Then Return 0 + Return (TotalSolutionsRejected / TotalSolutionsSubmitted) * 100 + End Get + End Property + +#End Region + +#Region " Methods" + + ''' + ''' Displays current statistic data + ''' + Private Sub StatsDisplayCallBack() + + Static lines As String = Logger.GetStatFmt + Static values() As Object + + SyncLock WorkerLock + + values = { + AppDurationTime.ToString("dd\.hh\:mm\:ss"), + App.Instance.PoolMgr.ActivePool, + TotalJobsReceived, + ConnectedMiners, + ScaleHashes(HashRate), + TotalSolutionsSubmitted, + StalePercent, + RejectPercent + } + + End SyncLock + + Logger.Log(2, String.Format(Logger.GetStatFmt, values), "Stats") + + End Sub + + + ''' + ''' Creates a supersegment among all workers + ''' + Private Sub OptiSuperSegmentCallBack() + + ' Things may have changed while running + If App.Instance.Settings.NoFee Then + _tmrOptiSegments.Dispose() + Return + End If + + ' Tries to compact segments so they're adjacent + ' as much as (reasonably) possible + If _rangesTree.Count > 1 Then + + Dim ranges As List(Of WorkerRangeItem) = _rangesTree.Items.ToList() + ranges.Sort(New WorkerRangeItemComparer) + + For i As Integer = 1 To ranges.Count - 1 + + Dim minStart As UInt64 = ranges(i - 1).Range.To + minStart = (minStart + Math.Pow(2, App.Instance.Settings.WorkersSpacing)) + Dim rWr As WorkerRangeItem = ranges(i) + + ' If this segment starts well beyond this limit then move it to this limit + If rWr.Range.From.CompareTo(minStart) > 0 Then + + ' Try locate the corresponding client to transmit message + Dim rWrClient As Clients.Client = Nothing + Try + + rWrClient = App.Instance.ClntMgr.Clients.Where(Function(c) c.Id = rWr.Id).SingleOrDefault + If rWrClient Is Nothing Then Throw New KeyNotFoundException + + If App.Instance.Settings.LogVerbosity >= 5 Then + Logger.Log(5, $"Assigned new start nonce {minStart} to client {rWrClient.WorkerOrId}", "Proxy") + End If + Logger.Log(1, "Optimizing nonces' search range ...", "Proxy") + + ' Compose a new message to instruct client to + ' adopt a new start nonce (noncescrambler) + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 5), + New KeyValuePair(Of String, JsonValue)("method", "miner_setscramblerinfo"), + New KeyValuePair(Of String, JsonValue)("params", New JsonObject From { + New KeyValuePair(Of String, JsonValue)("noncescrambler", minStart) + }) + } + + rWrClient.SendAPIMessage(jReq.ToString) + + ' A new adjustment will be performed on next round + Exit For + + Catch exNotFound As KeyNotFoundException + + ' Probably got disconnected in the mean time + + Catch ex As Exception + + Logger.Log(0, String.Format("Error : {0}", ex.GetBaseException.Message), "Proxy") + + End Try + + End If + + Next + + End If + + ' Compute donation timings after a minimum activity of 15 minutes + If DONATE_LEVEL > 0 AndAlso AppDurationTime.TotalMinutes >= 15 Then + + Dim devFeeComputedSeconds As Double = AppDurationTime.TotalSeconds * DONATE_LEVEL + Dim devFeeNextRunSeconds As Double = Math.Round((devFeeComputedSeconds - DonationDuration), 0) + If devFeeNextRunSeconds >= 30 Then + App.Instance.PoolMgr.StartDevFee(devFeeNextRunSeconds) + ElseIf devFeeNextRunSeconds > 0 Then + If GetRandom(1, 100) > 75 Then + App.Instance.PoolMgr.StartDevFee(30) + End If + End If + + End If + + + End Sub + +#End Region + + End Class + +End Namespace diff --git a/Core/Worker.vb b/Core/Worker.vb new file mode 100644 index 0000000..9c4e76c --- /dev/null +++ b/Core/Worker.vb @@ -0,0 +1,61 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace Core + + Public Enum WorkerState + Stopped + Starting + Started + Stopping + End Enum + + Public MustInherit Class Worker + + Private _state As WorkerState = WorkerState.Stopped + + Protected Shared WorkerLock As New Object + Protected WorkerThread As Threading.Thread + + Public ReadOnly Property State As WorkerState + Get + Return _state + End Get + End Property + + Public Overridable Sub StartWorking() + + SyncLock (WorkerLock) + _state = WorkerState.Started + End SyncLock + + End Sub + + Public Overridable Sub StopWorking() + + SyncLock (WorkerLock) + _state = WorkerState.Stopped + End SyncLock + + End Sub + + End Class + +End Namespace + diff --git a/Logger.vb b/Logger.vb new file mode 100644 index 0000000..81e9b4c --- /dev/null +++ b/Logger.vb @@ -0,0 +1,72 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core + +Public Class Logger + + Private Shared msgFormat1 As String = " {0:MMM dd HH:mm:ss.fff} | {1,-6} | {2}" + Private Shared msgFormat2 As String = " {0,147}" + Private Shared statHeader0 As String = "----------- + --------------------------- + -------------- + ------ + --------- + -------------- + ------ + ------ +" + Private Shared statHeader1 As String = " Total | Active | Total Jobs | Miners | Hashing | Submitted | Kn % | Kn % |" + Private Shared statHeader3 As String = " run time | Pool | Received | Count | Power / s | Solutions | Stale | Reject |" + Private Shared statHeader4 As String = "----------- + --------------------------- + -------------- + ------ + --------- + -------------- + ------ + ------ +" + Private Shared statLineFmt As String = "{0,11} | {1,-27} | {2,14:N0} | {3,6:N0} | {4,9:N2} | {5,14:N0} | {6,6:N2} | {7,6:N2} |" + + Public Shared Function GetStatFmt() As String + Return statLineFmt + End Function + + Public Shared Sub Log(severity As Integer, message As String, Optional category As String = "Info") + + Static statsRows As Integer = 0 + + ' Severity goes from + ' 0 - Error + ' 1 - Info + ' 2 - Stats + ' 3 - Connections / Disconnections + ' 4 - Logins / Subscriptions + ' 5 - Workers hashrates + ' 6 - Jobs notification & Workers Submissions + ' 7 - Low level socket Connections / Disconnections + ' ... + ' 9 - Debug Json + + If severity > App.Instance.Settings.LogVerbosity Then Return + + ' For stat output + If (severity = 2) Then + If statsRows >= 30 Then + Console.Out.WriteLine(msgFormat2, statHeader0) + Console.Out.WriteLine(msgFormat2, statHeader1) + Console.Out.WriteLine(msgFormat2, statHeader3) + Console.Out.WriteLine(msgFormat2, statHeader4) + statsRows = 0 + End If + Console.Out.WriteLine(msgFormat1, DateTime.Now, "Stats", message) + statsRows += 1 + Else + statsRows = 30 + Console.Out.WriteLine(msgFormat1, DateTime.Now, category, message) + End If + + End Sub + +End Class diff --git a/Pools/Pool.vb b/Pools/Pool.vb new file mode 100644 index 0000000..94164c4 --- /dev/null +++ b/Pools/Pool.vb @@ -0,0 +1,373 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports System.Net + +Namespace Pools + + ''' + ''' Abstraction for an host endpoint + ''' + Public Class Pool + +#Region " Fields" + + Private _host As String + Private _ports() As Integer + + Private _ipAddressList As New List(Of PoolIpAddress) + Private _ipEndPoints As New Queue(Of IPEndPoint) + + Private _lastProbedOn As DateTime = DateTime.MinValue + Private _isValid As Boolean = False + + Public IsPrimary As Boolean = False '<-- Primary pool is the first being added + + ' Stratum login for THIS pool (if any) + Private _stratumLogin As String '<-- Specific Authentication credentials for this Pool + Private _stratumPassw As String = "x" '<-- Specific Authentication credentials for this Pool + Private _stratumWorker As String = String.Empty '<-- Specific Authentication credentials for this Pool + + Public DevFeeAddress As String = String.Empty '<-- DevFee address for this Pool + Public JobsReceived As Long = 0 + Public KnownStaleSolutions As Long = 0 + Public SolutionsSubmitted As Long = 0 + Public SolutionsAccepted As Long = 0 + Public SolutionsRejected As Long = 0 + Public SoftErrors As Integer = 0 + Public HardErrors As Integer = 0 + Public IsFeeAuthorized As Boolean = False + + +#End Region + +#Region " Constructor" + + Public Sub New() + End Sub + + Public Sub New(hostName As String, hostPort As Integer) + + _host = hostName + AddPort(hostPort) + + ' If pool host is already an IP address then no need to probe + ' and / or resolve + Dim tmpIpAddress As Net.IPAddress = Nothing + If Net.IPAddress.TryParse(_host, tmpIpAddress) Then + _ipAddressList.Add(New PoolIpAddress With {.IpAddress = tmpIpAddress}) + _isValid = True + Else + ' Validate host name + If Not Core.Helpers.IsValidHostName(_host) Then + Logger.Log(0, String.Format("Pool Host {0} is neither a valid IP address nor a valid hostname", _host), "Err") + Else + _isValid = True + End If + End If + + End Sub + + Public Sub New(hostName As String, portNumbers() As Integer) + + _host = hostName + For i As Integer = 0 To portNumbers.Length - 1 + If portNumbers(i) > 0 AndAlso portNumbers(i) < 65535 Then + AddPort(portNumbers(i)) + End If + Next + + ' If pool host is already an IP address then no need to probe + ' and / or resolve + Dim tmpIpAddress As Net.IPAddress = Nothing + If Net.IPAddress.TryParse(_host, tmpIpAddress) Then + _ipAddressList.Add(New PoolIpAddress With {.IpAddress = tmpIpAddress}) + _isValid = True + Else + ' Validate host name + If Not Core.Helpers.IsValidHostName(_host) Then + Logger.Log(0, String.Format("Pool Host {0} is neither a valid IP address nor a valid hostname", _host), "Err") + Else + _isValid = True + End If + End If + + + End Sub + +#End Region + +#Region " Properties" + + Public ReadOnly Property Host As String + Get + Return _host + End Get + End Property + + Public ReadOnly Property Ports As Integer() + Get + Return _ports + End Get + End Property + + Public ReadOnly Property LastProbedOn As DateTime + Get + Return _lastProbedOn + End Get + End Property + + Public ReadOnly Property IsValid As Boolean + Get + Return _isValid + End Get + End Property + + Public ReadOnly Property IsProbed As Boolean + Get + Return Not _lastProbedOn = DateTime.MinValue + End Get + End Property + + Public ReadOnly Property IpEndPoints As Queue(Of IPEndPoint) + Get + Return _ipEndPoints + End Get + End Property + + Public Property StratumLogin As String + Get + If _stratumLogin <> String.Empty Then + Return _stratumLogin + ElseIf App.Instance.Settings.PoolsStratumLogin <> String.Empty Then + Return App.Instance.Settings.PoolsStratumLogin + Else + Return String.Empty + End If + End Get + Set(value As String) + _stratumLogin = value + End Set + End Property + + Public Property StratumPassw As String + Get + If _stratumLogin <> String.Empty Then + Return _stratumPassw + ElseIf App.Instance.Settings.PoolsStratumLogin <> String.Empty Then + Return App.Instance.Settings.PoolsStratumPassword + Else + Return String.Empty + End If + End Get + Set(value As String) + _stratumPassw = value + End Set + End Property + + Public Property StratumWorker As String + Get + If _stratumWorker <> String.Empty Then + Return _stratumWorker + ElseIf App.Instance.Settings.PoolsStratumWorker <> String.Empty Then + Return App.Instance.Settings.PoolsStratumWorker + Else + Return String.Empty + End If + End Get + Set(value As String) + _stratumWorker = value + End Set + End Property + +#End Region + +#Region " Methods" + + Public Sub AddPort(portNumber As Integer) + + If _ports Is Nothing Then + _ports = {portNumber} + Else + If Not _ports.Contains(portNumber) Then + Array.Resize(Of Integer)(_ports, _ports.Length + 1) + _ports(_ports.Length - 1) = portNumber + End If + End If + + End Sub + + Public Sub AddPort(portNumbers As Integer()) + For i As Integer = 0 To portNumbers.Length - 1 + AddPort(portNumbers(i)) + Next + End Sub + + Public Sub InitIpEndPointsQueue() + + _ipEndPoints = New Queue(Of IPEndPoint) + + If _ipAddressList.Count > 0 Then + + _ipAddressList.Sort() + For addrIdx As Integer = 0 To _ipAddressList.Count - 1 + For portIdx As Integer = 0 To _ports.Length - 1 + _ipEndPoints.Enqueue(New IPEndPoint(_ipAddressList(addrIdx).IpAddress, _ports(portIdx))) + Next + Next + + End If + + End Sub + + Public Function GetAddressQueue() As Queue(Of IPAddress) + + If _ipAddressList.Count = 0 Then Return New Queue(Of IPAddress) + _ipAddressList.Sort() + Dim retQueue As New Queue(Of IPAddress) + For i As Integer = 0 To _ipAddressList.Count - 1 + retQueue.Enqueue(_ipAddressList(i).IpAddress) + Next + Return retQueue + + End Function + + Public Sub Resolve() + + ' If Host is already an IP address no need to resolve + If _ipAddressList.Count > 0 AndAlso (_ipAddressList(0).IpAddress.ToString = _host) Then Return + + Dim hostInfo As IPHostEntry = Nothing + Try + hostInfo = Dns.GetHostEntry(_host) + For Each tmpIpAddress As IPAddress In hostInfo.AddressList + _ipAddressList.Add(New PoolIpAddress With {.IpAddress = tmpIpAddress}) + Next + _isValid = True + Catch ex As Exception + Logger.Log(0, String.Format("Pool {0} does not resolve to any valid Ip", _host), "Err") + _isValid = False + End Try + + End Sub + + Public Async Function ResolveAsync() As Task + + ' If Host is already an IP address no need to resolve + If _ipAddressList.Count > 0 AndAlso (_ipAddressList(0).IpAddress.ToString = _host) Then Return + + Dim hostInfo As IPHostEntry = Nothing + Try + hostInfo = Await Dns.GetHostEntryAsync(_host) + For Each tmpIpAddress As IPAddress In hostInfo.AddressList + _ipAddressList.Add(New PoolIpAddress With {.IpAddress = tmpIpAddress}) + Next + _isValid = True + Catch ex As Exception + Logger.Log(0, String.Format("Pool {0} does not resolve to any valid Ip", _host), "Err") + _isValid = False + End Try + + End Function + + Public Async Function ResolveAsync(refresh As Boolean) As Task + + _ipAddressList.Clear() + _isValid = False + Await ResolveAsync() + + End Function + + Public Async Function ProbeAsync() As Task + + ' No need to probe for less than 2 ipaddresses + If _ipAddressList.Count < 2 Then + _ipAddressList.Sort() + Return + End If + + Logger.Log(2, String.Format("Probing {1}'s {0} ip addresses", _ipAddressList.Count, _host), "Probe") + + + Dim pingQry As NetworkInformation.Ping = New NetworkInformation.Ping() + Dim pingRep As NetworkInformation.PingReply + Dim pingRtt As Integer() + + For Each _poolIpAddress As PoolIpAddress In _ipAddressList + + ' 10 tests + pingRtt = Enumerable.Repeat(Of Integer)(1000, 10).ToArray + For testNum As Integer = 0 To pingRtt.Length - 1 + + Try + pingRep = Await pingQry.SendPingAsync(address:=_poolIpAddress.IpAddress, timeout:=pingRtt(testNum)) + 'Console.WriteLine([Enum].GetName(GetType(NetworkInformation.IPStatus), pingRep.Status)) + If pingRep.Status = NetworkInformation.IPStatus.TimedOut Then Exit For + pingRtt(testNum) = pingRep.RoundtripTime + Catch ex As Exception + ' Lack of response or timeout + End Try + + Next + + ' Store avg response time + _poolIpAddress.RoundTripTime = CInt(Math.Round(pingRtt.Average(), 0)) + _poolIpAddress.Icmp = True + Logger.Log(2, String.Format("Ip {0,16} : avg time {1} ms.", _poolIpAddress.IpAddress.ToString, _poolIpAddress.RoundTripTime), "Probe") + + Next + + _ipAddressList.Sort() + _lastProbedOn = DateTime.Now + + End Function + + +#End Region + +#Region " Private Classes" + + Private Class PoolIpAddress + + Implements IComparable(Of PoolIpAddress) + + Public IpAddress As Net.IPAddress + Public Icmp As Boolean + Public RoundTripTime As Integer + + Public Function CompareTo(other As PoolIpAddress) As Integer Implements IComparable(Of PoolIpAddress).CompareTo + + If other Is Nothing Then Return 1 + If Icmp AndAlso Not other.Icmp Then Return -1 + If Not Icmp AndAlso other.Icmp Then Return 1 + If Not Icmp AndAlso Not other.Icmp Then Return 0 + + Return RoundTripTime.CompareTo(other.RoundTripTime) + + End Function + + End Class + +#End Region + + End Class + + +End Namespace \ No newline at end of file diff --git a/Pools/PoolManager.vb b/Pools/PoolManager.vb new file mode 100644 index 0000000..05883b1 --- /dev/null +++ b/Pools/PoolManager.vb @@ -0,0 +1,1183 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports nethproxy.Sockets +Imports System.Json +Imports System.Threading + +Namespace Pools + + Public Class PoolManager + + +#Region " Fields" + + ' References to singletons + Private _settings As Settings = App.Instance.Settings + Private _telemetry As Telemetry = App.Instance.Telemetry + + Private _tskNetworkAvailable As Task + Private _ctsNetworkAvailable As CancellationTokenSource + + ' All pools + Private _poolsQueue As Queue(Of Pool) = New Queue(Of Pool) + + ' Pool and Mining jobs related members + Private _poolStatus As PoolStatus = PoolStatus.NotConnected + Private _currentPool As Pool + Private _stratumMode As StratumModeEnum = StratumModeEnum.Undefined + + Private _jobHeaders As New SlidingQueue(Of String)(5) ' Keeps track of last 5 jobs received + Public Property CurrentJob As Core.Job + Private _currentDiff As Double = 0 + + ' Devfee + Private _devFeeStartedOn As DateTime = DateTime.MinValue + Private _devAddress As String = String.Empty + + + ' Connection Socket + Private WithEvents _socket As New AsyncSocket("Pool") + + ' Lock and context + Private _context As String = "Pool" + Private _lockObj As New Object + Private _isRunning As Boolean = False + + ' Timers + Private WithEvents _jobTimeoutTimer As Timers.Timer + Private WithEvents _responseTimeoutTimer As Timers.Timer + Private WithEvents _devFeeIntervalTimer As New Timers.Timer + + ' The queue of submissions + Private _submissionsQueue As New Concurrent.ConcurrentQueue(Of SubmissionEntry) + + ''' + ''' Represent a share submission entry + ''' + Private Class SubmissionEntry + Public TimeStamp As DateTime + Public OriginClient As Clients.Client + Public OriginId As Integer + End Class + +#End Region + +#Region " Properties" + + ''' + ''' Gets the actively connected pool + ''' + ''' + Public ReadOnly Property ActivePool As String + Get + ' May throw if not connected + If Not IsConnected Then + Return "Not Connected" + Else + Try + Return (_currentPool.Host + ":" + _socket.RemoteEndPoint.Port.ToString) + Catch ex As Exception + Return "Not connected" + End Try + End If + End Get + End Property + + ''' + ''' Gets the time elapsed on current connected pool + ''' + ''' + Public ReadOnly Property ConnectionDuration As TimeSpan + Get + If _socket Is Nothing Then Return New TimeSpan(0, 0, 0) + Return _socket.ConnectionDuration + End Get + End Property + + ''' + ''' Gets wether or not the underlying socket is connected + ''' + ''' + Public ReadOnly Property IsConnected As Boolean + Get + Return _poolStatus.HasBitFlag(PoolStatus.Connected) + End Get + End Property + + ''' + ''' Gets wether or not we're Subscribed + ''' + ''' True / False + Public ReadOnly Property IsSubscribed As Boolean + Get + Return _poolStatus.HasBitFlag(PoolStatus.Subscribed) + End Get + End Property + + ''' + ''' Gets wether or not we're Authorized + ''' + ''' True / False + Public ReadOnly Property IsAuthorized As Boolean + Get + Return _poolStatus.HasBitFlag(PoolStatus.Authorized) + End Get + End Property + + ''' + ''' Gets a reference to currently working pool + ''' + ''' + Public ReadOnly Property CurrentPool As Pool + Get + Return _currentPool + End Get + End Property + + ''' + ''' Gets the Queue of currently configured pools + ''' + ''' + Public ReadOnly Property PoolsQueue As Queue(Of Pool) + Get + Return _poolsQueue + End Get + End Property + + ''' + ''' Gets Stratum Login For Current Pool + ''' + ''' A String + Public ReadOnly Property StratumLogin As String + Get + + If _currentPool Is Nothing Then + Return String.Empty + End If + + If Not String.IsNullOrEmpty(_devAddress) Then + Return _devAddress + Else + Return _currentPool.StratumLogin + End If + + End Get + End Property + + ''' + ''' Gets current stratum mode + ''' + ''' + Public ReadOnly Property StratumMode As StratumModeEnum + Get + Return _stratumMode + End Get + End Property + + ''' + ''' Whether or not pool is on dev fee + ''' + ''' + Public ReadOnly Property IsFeeOn As Boolean + Get + Return Not String.IsNullOrEmpty(_devAddress) + End Get + End Property + +#End Region + +#Region " Constructor" + + Public Sub New() + End Sub + +#End Region + +#Region " Start / Stop" + + ''' + ''' Starts the pool + ''' + Public Sub Start() + + If _isRunning Then Return + _isRunning = True + Connect() + + End Sub + + ''' + ''' Stops the pool + ''' + Public Sub [Stop]() + + _isRunning = False + Disconnect() + + If _tskNetworkAvailable IsNot Nothing Then + Try + _ctsNetworkAvailable.Cancel() + Catch ex As Exception + + End Try + End If + + End Sub + +#End Region + +#Region " Events" + + ''' + ''' Fires whenever a new job is received from the pool + ''' + Public Event EventNewJobReceived(ByVal JsonJob As JsonObject) + +#End Region + +#Region " Timers Handlers" + + ''' + ''' Checks the delay from last job is not greater than --work-timeout + ''' + Private Sub OnJobTimeoutTimerElapsed() Handles _jobTimeoutTimer.Elapsed + + If Not IsConnected Then Return + Logger.Log(1, String.Format("No new job from pool in {0} seconds. Disconnecting ...", _settings.PoolsWorkTimeout), _context) + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Disconnect)) + + End Sub + + ''' + ''' Checks the delay of each response to solution submission + ''' + Private Sub OnResponseTimeoutTimerElapsed() Handles _responseTimeoutTimer.Elapsed + + If _submissionsQueue.IsEmpty Then Return + Logger.Log(1, String.Format("Response time from Pool above {0:N0} ms. Disconnect !", _settings.PoolsResponseTimeout), _context) + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Disconnect)) + + End Sub + +#End Region + +#Region " Methods" + + ''' + ''' Starts the donation fee period + ''' + ''' Number of seconds of duration + Public Sub StartDevFee(seconds As Double) + + ' At least a 30 seconds run + If _currentPool Is Nothing OrElse IsAuthorized = False OrElse seconds < 30 Then Return + + If _devFeeStartedOn <> DateTime.MinValue OrElse String.IsNullOrEmpty(_devAddress) = False Then + Return + Else + _devFeeIntervalTimer.Interval = seconds * 1000 + _devFeeIntervalTimer.AutoReset = False + _devFeeIntervalTimer.Enabled = False + End If + Dim p As String = $"{_currentPool.Host}:{_socket.RemoteEndPoint.Port}".ToLower() + Dim d As String = GetDevAddress(p) + If String.IsNullOrEmpty(d) Then + Logger.Log(1, "DevFee not authorized. Switching to --no-fee mode.") + App.Instance.Settings.NoFee = True + _devFeeStartedOn = DateTime.MinValue + _devAddress = String.Empty + Return + Else + _devAddress = d + End If + + + Select Case StratumMode + + Case StratumModeEnum.Stratum + + If _currentPool.IsFeeAuthorized = False Then + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 3), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "mining.authorize"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray({d, "x"}))} + SendMessage(jReq.ToString()) + + End If + + Case StratumModeEnum.Ethproxy + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 1), + New KeyValuePair(Of String, JsonValue)("method", "eth_submitLogin"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray From {d}) + } + SendMessage(jReq.ToString()) + + End Select + + End Sub + + ''' + ''' Stops the donation fee period + ''' + Public Sub StopDevFee() Handles _devFeeIntervalTimer.Elapsed + + If _devFeeStartedOn = DateTime.MinValue Then Return + Dim ranForSeconds As Double = DateTime.Now.Subtract(_devFeeStartedOn).TotalSeconds + _telemetry.DonationDuration = _telemetry.DonationDuration + CLng(ranForSeconds) + _devFeeStartedOn = DateTime.MinValue + _devAddress = String.Empty + _devFeeIntervalTimer.Stop() + _devFeeIntervalTimer.Enabled = False + + Logger.Log(1, $"DevFee stopped. Ran for {ranForSeconds.ToString} seconds.", _context) + + ' Restore normal operations + Select Case StratumMode + Case StratumModeEnum.Stratum + + ' Actually nothing to do here + 'Dim jReq As New JsonObject From { + ' New KeyValuePair(Of String, JsonValue)("id", 3), + ' New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + ' New KeyValuePair(Of String, JsonValue)("method", "mining.authorize"), + ' New KeyValuePair(Of String, JsonValue)("params", New JsonArray({CurrentPool.StratumLogin, CurrentPool.StratumPassw}))} + 'SendMessage(jReq.ToString()) + + Case StratumModeEnum.Ethproxy + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 1), + New KeyValuePair(Of String, JsonValue)("method", "eth_submitLogin"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray From {CurrentPool.StratumLogin}) + } + SendMessage(jReq.ToString()) + + End Select + + + End Sub + + ''' + ''' Adds a new pool definition + ''' + ''' Host Name or Ip Address + ''' Port to connect to 1-65535 + Public Sub AddPool(poolHost As String, poolPort As Integer) + + Dim pEp As Pool = Nothing + + ' Look if same host with different port + If _poolsQueue.Count > 0 Then pEp = _poolsQueue.AsEnumerable.Where(Function(p) p.Host.ToLower = poolHost.ToLower And p.StratumLogin = String.Empty And p.StratumPassw = "x" And p.StratumWorker = String.Empty).SingleOrDefault + + If pEp IsNot Nothing Then + + pEp.AddPort(poolPort) + + Else + + pEp = New Pool(poolHost, poolPort) + pEp.Resolve() + _poolsQueue.Enqueue(pEp) + + End If + + End Sub + + ''' + ''' Adds a new pool definition + ''' + ''' A object + Public Sub AddPool(poolEndPoint As Pool) + + Dim pEp As Pool = Nothing + + ' Look if same host with different port + If _poolsQueue.Count > 0 Then + pEp = _poolsQueue.AsEnumerable.Where(Function(p) p.Host.ToLower = poolEndPoint.Host.ToLower And p.StratumLogin = poolEndPoint.StratumLogin.ToLower And p.StratumPassw = poolEndPoint.StratumPassw And p.StratumWorker = poolEndPoint.StratumWorker).SingleOrDefault + End If + If pEp Is Nothing Then + poolEndPoint.Resolve() + _poolsQueue.Enqueue(poolEndPoint) + Else + pEp.AddPort(poolEndPoint.Ports) + End If + + End Sub + + ''' + ''' Invokes connection to socket + ''' + Public Sub Connect() + + If Not _isRunning Then Return + + ' Reset stratum mode + _stratumMode = StratumModeEnum.Undefined + + _ctsNetworkAvailable = New CancellationTokenSource + _tskNetworkAvailable = Task.Factory.StartNew(AddressOf Core.WaitNetworkAvailable, _ctsNetworkAvailable.Token) + + ' Wait for network connectivity + If _tskNetworkAvailable IsNot Nothing Then + _tskNetworkAvailable.Wait() + If _tskNetworkAvailable.Status = TaskStatus.Canceled Then Return + End If + + If _currentPool IsNot Nothing AndAlso _currentPool.IpEndPoints.Count = 0 Then + + ' We've already consumed all available IPs for this pool + ' switch to next + Interlocked.Increment(_telemetry.TotalPoolSwitches) + _poolsQueue.Enqueue(_poolsQueue.Dequeue()) + _currentPool = _poolsQueue.Peek() + + End If + + + If _currentPool Is Nothing Then + _currentPool = _poolsQueue.Peek() + Logger.Log(1, String.Format("Selected Pool : {0}", _currentPool.Host)) + End If + + If _currentPool.IpEndPoints.Count() = 0 Then + + _currentPool.Resolve() + + If Not _settings.PoolsNoProbe Then + + ' Do not probe again + If Not _currentPool.IsProbed Then + Dim tskProbe As Task = _currentPool.ProbeAsync + tskProbe.Wait() + End If + + End If + + _currentPool.InitIpEndPointsQueue() + + End If + + ' Reset values + CurrentJob = Nothing + _currentDiff = 0 + + ' Peek first endpoint in queue + Interlocked.Increment(_telemetry.TotalPoolConnectionAttempts) + _socket.Connect(_currentPool.IpEndPoints.Peek()) + + End Sub + + ''' + ''' Forces disconnection + ''' + Protected Sub Disconnect() + + CurrentJob = Nothing + _currentDiff = 0 + _jobHeaders.Clear() + _currentPool.IsFeeAuthorized = False + + If Not String.IsNullOrEmpty(_devAddress) Then + StopDevFee() + End If + + If _jobTimeoutTimer IsNot Nothing Then _jobTimeoutTimer.Stop() + _socket.Disconnect() + + End Sub + + ''' + ''' Submits solution to pool + ''' + ''' The holding the solution sent by worker + Public Function SubmitSolution(jsonSolutionMessage As JsonObject, originClient As Clients.Client) As Integer + + ' Return codes + ' 0 - Wasted (no connection or not authorized) + ' 1 - Submitted + ' 2 - Submitted Stale + + Dim retVar As Integer = 0 + If Not _isRunning Then Return retVar + + ' Assuming a first in first out queue for solutions + ' each stop watch should keep amount for accepted/rejected response + SyncLock _lockObj + + If Not IsAuthorized Then Return retVar + + ' Check if Stale Solution and remove provided worker from client + ' Also ensure id = 4 ... we need this + jsonSolutionMessage("id") = 4 + Dim isStale As Boolean = False + If CurrentJob IsNot Nothing Then + If CurrentJob.Header.IndexOf(jsonSolutionMessage("params")(3).ToString.Replace("""", String.Empty)) < 0 Then + isStale = True + End If + End If + If jsonSolutionMessage.ContainsKey("worker") Then jsonSolutionMessage.Remove("worker") + + ' We always receive submission messages in stratum format + ' if we're in ethproxy mode change accordingly + If _stratumMode = StratumModeEnum.Ethproxy Then + + jsonSolutionMessage("method") = "eth_submitWork" + Dim newParams As JsonArray = New JsonArray({ + jsonSolutionMessage("params")(2), + jsonSolutionMessage("params")(3), + jsonSolutionMessage("params")(4) + }) + jsonSolutionMessage("params") = newParams + + Else + + ' Replace with current stratum login + jsonSolutionMessage("params").Item(0) = StratumLogin + + End If + + ' Add worker name if needed + If (Not IsFeeOn AndAlso _settings.PoolsReportWorkerNames AndAlso Not String.IsNullOrEmpty(originClient.WorkerName)) Then + jsonSolutionMessage.Add(New KeyValuePair(Of String, JsonValue)("worker", originClient.WorkerName)) + End If + + ' Enqueue a new datetime + ' We assume solutions are accepted FIFO style + _submissionsQueue.Enqueue(New SubmissionEntry With {.TimeStamp = DateTime.Now, .OriginClient = originClient, .OriginId = jsonSolutionMessage("id")}) + + If isStale Then + Interlocked.Increment(_telemetry.TotalKnownStaleSolutions) + Interlocked.Increment(_currentPool.KnownStaleSolutions) + End If + + ' Log submission & start response timer + SendMessage(jsonSolutionMessage.ToString) + If _responseTimeoutTimer Is Nothing Then + _responseTimeoutTimer = New Timers.Timer With {.Interval = _settings.PoolsResponseTimeout, .AutoReset = False, .Enabled = True} + Else + _responseTimeoutTimer.Stop() + _responseTimeoutTimer.Interval = _settings.PoolsResponseTimeout + _responseTimeoutTimer.Start() + End If + Logger.Log(6, originClient.WorkerOrId + If(isStale, " stale", String.Empty) + " nonce " + jsonSolutionMessage("params")(2).ToString, "Worker") + + Interlocked.Increment(_telemetry.TotalSolutionsSubmitted) + Interlocked.Increment(_currentPool.SolutionsSubmitted) + + retVar += 1 + If isStale Then retVar += 1 + + End SyncLock + + Return retVar + + End Function + + ''' + ''' Submits Hashrate to pool + ''' + ''' + Public Sub SubmitHashrate(jsonHashrate As JsonObject) + + If Not IsAuthorized Then Return + jsonHashrate("id") = 9 + SendMessage(jsonHashrate) + + End Sub + + +#End Region + +#Region " Private Methods" + + ''' + ''' Process a message received by the pool + ''' + Private Sub ProcessMessage(message As String) + + If String.IsNullOrEmpty(message) Then Return + + ' Out message received + Logger.Log(9, "<< " & message, _context) + + Dim jsonMsg As JsonObject = Nothing + Dim msgId As Integer = 0 + Dim msgMethod As String = String.Empty + + Dim isNotification As Boolean = False ' Whether or not this message is a reply to previous request or is a broadcast notification + Dim isSuccess As Boolean = False ' Whether or not this is a succesful or failed response (implies _isNotification = false) + Dim errorReason As String = String.Empty ' The error (if any) descriptive text (if any) + + Try + + jsonMsg = JsonValue.Parse(message) + With jsonMsg + + If .ContainsKey("id") AndAlso .Item("id") IsNot Nothing Then .TryGetValue("id", msgId) + If .ContainsKey("method") AndAlso .Item("method") IsNot Nothing Then .TryGetValue("method", msgMethod) + + If .ContainsKey("error") Then + If .Item("error") Is Nothing Then + isSuccess = True + Else + errorReason = .Item("error").ToString + End If + Else + isSuccess = True + End If + + If .ContainsKey("result") Then + If .Item("result").JsonType = JsonType.Array Then + If .Item("result").Count > 0 Then + isSuccess = True + End If + ElseIf .Item("result").JsonType = JsonType.Boolean Then + .TryGetValue("result", isSuccess) + End If + End If + + ' Messages with a method or msgId = 0 + If Not String.IsNullOrEmpty(msgMethod) OrElse msgId = 0 Then + isNotification = True + End If + + If _stratumMode = StratumModeEnum.Ethproxy Then + If isNotification AndAlso .ContainsKey("result") AndAlso .Item("result").JsonType = JsonType.Array AndAlso .Item("result").Count > 0 Then + msgMethod = "mining.notify" + End If + End If + + + End With + + Catch ex As Exception + + ' Invalid format of json + Logger.Log(0, String.Format("Invalid Json object received from Pool : {0}", ex.GetBaseException.Message), "Pool") + Return + + End Try + + + ' Handle responses + If Not isNotification Then + + Select Case msgId + + ' Handle response to mining.subscribe + Case 1 + + If Not isSuccess Then + + Select Case _stratumMode + + Case StratumModeEnum.TentativeStratum + + ' We've already tried Stratum and EthProxy + ' We can't test Ethereumstratum (NiceHash) as + ' this mode can't work (atm) with extranonces + If Not String.IsNullOrEmpty(errorReason) Then + Logger.Log(0, String.Format("Received error from pool : {0}", errorReason), _context) + End If + Logger.Log(1, "Subscription failed ! Disconnecting ...", _context) + _currentPool.HardErrors += 1 + Call Disconnect() + Return + + Case StratumModeEnum.TentativeEthProxy + + ' Try to fall back to Stratum Mode + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 1), + New KeyValuePair(Of String, JsonValue)("method", "mining.subscribe"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray From {}) + } + + _stratumMode = StratumModeEnum.TentativeStratum + SendMessage(jReq.ToString) + Return + + Case StratumModeEnum.Ethproxy + + If Not String.IsNullOrEmpty(_devAddress) Then + Logger.Log(1, "DevFee not authorized. Switching to --no-fee mode.") + App.Instance.Settings.NoFee = True + _devFeeStartedOn = DateTime.MinValue + _devAddress = String.Empty + Return + End If + + End Select + + + End If + + Select Case _stratumMode + + Case StratumModeEnum.TentativeStratum + + Logger.Log(1, "Stratum mode detected : Subscribed !", _context) + _poolStatus.SetFlags({PoolStatus.Subscribed}) + _stratumMode = StratumModeEnum.Stratum + + ' Send authorize request + Dim jsonReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 3), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "mining.authorize"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray({_currentPool.StratumLogin, _currentPool.StratumPassw})) + } + SendMessage(jsonReq.ToString()) + + Case StratumModeEnum.TentativeEthProxy + + Logger.Log(1, "EthProxy mode detected : Logged in !", _context) + _poolStatus.SetFlags({PoolStatus.Subscribed, PoolStatus.Authorized}) + _stratumMode = StratumModeEnum.Ethproxy + + ' Send getWork request + Dim jsonReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 5), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "eth_getWork"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray({})) + } + SendMessage(jsonReq.ToString()) + + Case StratumModeEnum.Ethproxy + + If Not String.IsNullOrEmpty(_devAddress) Then + Logger.Log(1, "DevFee authorized", _context) + _devFeeStartedOn = DateTime.Now + _devFeeIntervalTimer.Enabled = True + _devFeeIntervalTimer.Start() + End If + + ' Send getWork request + Dim jsonReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", 5), + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("method", "eth_getWork"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray({})) + } + SendMessage(jsonReq.ToString()) + + End Select + + + ' Handle response to mining.authorize + Case 3 + + If Not isSuccess Then + + If Not String.IsNullOrEmpty(_devAddress) Then + + Logger.Log(1, "DevFee not authorized. Switching to --no-fee mode.") + App.Instance.Settings.NoFee = True + _devFeeStartedOn = DateTime.MinValue + _devAddress = String.Empty + Return + + End If + + + Logger.Log(1, "Authorization failed ! Disconnecting ...", _context) + _currentPool.HardErrors += 1 + Call Disconnect() + Return + + End If + + If Not String.IsNullOrEmpty(_devAddress) Then + + Logger.Log(1, "DevFee authorized", _context) + _devFeeStartedOn = DateTime.Now + _devFeeIntervalTimer.Enabled = True + _devFeeIntervalTimer.Start() + _currentPool.IsFeeAuthorized = True + + Else + + Logger.Log(1, String.Format("Authorized account {0}", _currentPool.StratumLogin), _context) + _poolStatus.SetFlags({PoolStatus.Authorized}) + + End If + + + ' Handle response to submitted solution + Case 4 + + SyncLock _lockObj + + Dim sentEntry As New SubmissionEntry + Dim responseTime As New TimeSpan(0) + If Not _submissionsQueue.TryDequeue(sentEntry) Then + + sentEntry.TimeStamp = DateTime.Now + + Else + + ' Save response time + responseTime = DateTime.Now.Subtract(sentEntry.TimeStamp) + _telemetry.ResponseTimes.Enqueue(responseTime.TotalMilliseconds) + + ' Report back to client same result + ' received from pool + sentEntry.OriginClient.Send(message) + + End If + + If isSuccess Then + Interlocked.Increment(_telemetry.TotalSolutionsAccepted) + Interlocked.Increment(_currentPool.SolutionsAccepted) + Logger.Log(6, String.Format("Solution accepted :-) [{0:N0}ms]", responseTime.TotalMilliseconds), _context) + Else + Interlocked.Increment(_telemetry.TotalSolutionsRejected) + Interlocked.Increment(_currentPool.SolutionsRejected) + If Not String.IsNullOrEmpty(errorReason) Then + Logger.Log(0, String.Format("Received error from pool : {0}", errorReason), _context) + End If + Logger.Log(6, String.Format("Solution rejected :-O [{0:N0}ms]", responseTime.TotalMilliseconds), _context) + End If + + ' If we have other submissions waiting for response restart + ' the clock + If Not _submissionsQueue.IsEmpty Then + _responseTimeoutTimer.Reset + End If + + End SyncLock + + Case 5 + + ' Response to first eth_getWork request for EthProxy stratum mode + isNotification = True + msgMethod = "mining.notify" + + Case 9 + + ' Response to hashrate submission + ' Nothing to do here + + Case 999 + + ' This unfortunate case should Not happen as none of the outgoing requests Is marked with id 999 + ' However it has been tested that ethermine.org responds with this id when error replying to + ' either mining.subscribe (1) Or mining.authorize requests (3) + ' To properly handle this situation we need to rely on Subscribed/Authorized states + + If Not isSuccess Then + + If Not IsSubscribed Then + + Logger.Log(0, String.Format("Subscription to pool failed : {0}", errorReason), _context) + Disconnect() + Return + + ElseIf IsSubscribed AndAlso IsAuthorized = False Then + + If String.IsNullOrEmpty(_devAddress) Then + + Logger.Log(0, String.Format("Authorization to pool failed : {0}", errorReason), _context) + Disconnect() + Return + + Else + + Logger.Log(1, "DevFee not authorized. Switching to --no-fee mode.") + App.Instance.Settings.NoFee = True + _devFeeStartedOn = DateTime.MinValue + _devAddress = String.Empty + Return + + End If + + End If + + End If + + Case Else + + Logger.Log("0", "Received unprocessable response from Pool. Discarding ...", _context) + Return + + End Select + + + End If + + ' Process notifications + If isNotification Then + + ' Handle notifications + Select Case msgMethod + + ' New job notification + + Case "mining.notify" + + Dim notifyJob As Core.Job = Nothing + If jsonMsg.ContainsKey("result") AndAlso jsonMsg("result").JsonType = JsonType.Array AndAlso jsonMsg("result").Count > 0 Then + notifyJob = New Core.Job(jsonMsg("result"), StratumModeEnum.Ethproxy) + ElseIf jsonMsg.ContainsKey("params") AndAlso jsonMsg("params").JsonType = JsonType.Array AndAlso jsonMsg("params").Count > 0 Then + notifyJob = New Core.Job(jsonMsg("params"), StratumModeEnum.Stratum) + Else + Return + End If + + + ' Compute time since last job + Dim timeSinceLastJob As TimeSpan = New TimeSpan(0) + + If CurrentJob IsNot Nothing Then + + timeSinceLastJob = notifyJob.TimeStamp.Subtract(CurrentJob.TimeStamp) + If timeSinceLastJob.TotalMilliseconds > _telemetry.MaxJobInterval Then + _telemetry.MaxJobInterval = timeSinceLastJob.TotalMilliseconds + End If + + ' Check we're not receiving a duplicate job + If _jobHeaders.Contains(notifyJob.Header) Then + Return + Else + _jobTimeoutTimer.Reset + _jobHeaders.Enqueue(notifyJob.Header) + End If + + ' Compute difficulty + If notifyJob.Target <> If(CurrentJob Is Nothing, String.Empty, CurrentJob.Target) Then + _currentDiff = GetDiffToTarget(notifyJob.Target) + Logger.Log(1, String.Format("Pool difficulty set to {0}", ScaleHashes(_currentDiff)), _context) + End If + + ' Set currentJob + CurrentJob = notifyJob + SyncLock _lockObj + _telemetry.TotalJobsReceived += 1 + _currentPool.JobsReceived += 1 + End SyncLock + + Else + + CurrentJob = notifyJob + ' Compute difficulty + _currentDiff = GetDiffToTarget(notifyJob.Target) + Logger.Log(1, String.Format("Pool difficulty set to {0}", ScaleHashes(_currentDiff)), _context) + + End If + + ' Log and notify workers + Logger.Log(6, String.Format("New job #{0} [{1:N2}s]", CurrentJob.Id, timeSinceLastJob.TotalSeconds), _context) + If EventNewJobReceivedEvent IsNot Nothing Then + RaiseEvent EventNewJobReceived(New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", Nothing), + New KeyValuePair(Of String, JsonValue)("method", "mining.notify"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray From {CurrentJob.Header, CurrentJob.Header, CurrentJob.Seed, CurrentJob.Target}) + }) + End If + + Case "client.get_version" + + ' Request of version + Dim jRes As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("id", msgId), + New KeyValuePair(Of String, JsonValue)("result", "neth-proxy " + GetType(Program).Assembly.GetName().Version.ToString()), + New KeyValuePair(Of String, JsonValue)("error", Nothing) + } + + SendMessage(jRes.ToString) + + Case Else + + Logger.Log(0, String.Format("Received unknown method {0} from pool", msgMethod), _context) + + End Select + + End If + + + End Sub + + ''' + ''' Sends the given message to the underlying socket + ''' + ''' The message to be sent + Private Sub SendMessage(message As String) + + ' Out message being sent + Logger.Log(9, ">> " & message, _context) + + _socket.Send(message) + + End Sub + + ''' + ''' Sends a json object to the underlying socket + ''' + ''' The to be sent + Private Sub SendMessage(jmessage As JsonObject) + + SendMessage(jmessage.ToString) + + End Sub + + ''' + ''' Forces disconnection from current pool and + ''' reconnect to failover pool (if any) + ''' + Public Sub SwitchPool() + + If Not IsConnected Then Return + + ' Clears all remaining IPs for this + ' pool and disconnects + While _currentPool.IpEndPoints.Count > 0 + _currentPool.IpEndPoints.Dequeue() + End While + Disconnect() + + End Sub + + ''' + ''' Forces disconnection and reconnection on next available ip + ''' + Public Sub Reconnect() + + If Not IsConnected Then Return + Disconnect() + + End Sub + +#End Region + +#Region " Async Socket Event Handlers" + + Private Sub OnSocketConnected(ByRef sender As AsyncSocket) Handles _socket.Connected + + SyncLock _lockObj + _poolStatus.SetFlags({PoolStatus.Connected}) + _poolStatus.UnsetFlags({PoolStatus.NotConnected}) + End SyncLock + + ' Initialize checks for worktimeout + If _jobTimeoutTimer Is Nothing Then + _jobTimeoutTimer = New Timers.Timer With { + .Interval = _settings.PoolsWorkTimeout * 1000, + .Enabled = True, + .AutoReset = True + } + End If + + Logger.Log(3, String.Format("Connection to {0} successful", _currentPool.Host), _context) + + ' Start receiving + sender.BeginReceive() + + ' Send subscription request + If Not IsSubscribed Then + + _stratumMode = StratumModeEnum.TentativeEthProxy + + Dim jReq As New JsonObject From { + New KeyValuePair(Of String, JsonValue)("jsonrpc", "2.0"), + New KeyValuePair(Of String, JsonValue)("id", 1), + New KeyValuePair(Of String, JsonValue)("method", "eth_submitLogin"), + New KeyValuePair(Of String, JsonValue)("params", New JsonArray From {StratumLogin}) + } + SendMessage(jReq.ToString) + + End If + + + End Sub + + Private Sub OnSocketConnectionFailed(ByRef sender As AsyncSocket) Handles _socket.ConnectionFailed + + ' Quit if stopped + If Not _isRunning Then Return + + ' Dequeue failed ip + Interlocked.Increment(_telemetry.TotalPoolConnectionFailed) + _currentPool.IpEndPoints.Dequeue() + + ' Resubmit new connection + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Connect)) + + + End Sub + + Private Sub OnSocketMessageReceived(ByRef sender As AsyncSocket, ByVal message As String) Handles _socket.MessageReceived + + ' Queue the message processing + ProcessMessage(message) + + End Sub + + Private Sub OnSocketDisconnected(ByRef sender As Object) Handles _socket.Disconnected + + Logger.Log(3, $"Pool {_currentPool.Host} disconnected", _context) + + SyncLock _lockObj + _poolStatus.SetFlags({PoolStatus.NotConnected}) + _poolStatus.UnsetFlags({PoolStatus.Connected, PoolStatus.Authorized, PoolStatus.Subscribed}) + End SyncLock + + ' Flush queue of submission times for nonces + ' as we won't receive answers for pending submissions + ' also inform clients + Dim item As SubmissionEntry = Nothing + While _submissionsQueue.Count > 0 + If _submissionsQueue.TryDequeue(item) Then + Dim jresponse As New Json.JsonObject + jresponse("id") = item.OriginId + jresponse("jsonrpc") = "2.0" + jresponse("result") = False + + Try + item.OriginClient.Send(jresponse.ToString()) + Catch ex As Exception + ' May be already disposed + End Try + + End If + End While + + If Not _isRunning Then Return + + ' Dequeue failed ip and start reconnect + If _currentPool.IpEndPoints.Count > 0 Then _currentPool.IpEndPoints.Dequeue() + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Connect)) + + End Sub + +#End Region + + + End Class + +End Namespace \ No newline at end of file diff --git a/Program.vb b/Program.vb new file mode 100644 index 0000000..9c042ab --- /dev/null +++ b/Program.vb @@ -0,0 +1,542 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports System.Runtime.Loader +Imports System.Json +Imports System.Text +Imports System.Threading + +Module Program + + Dim signalReceived As New ManualResetEventSlim() + Dim terminated As New ManualResetEventSlim() + + + Sub Main(args As String()) + + + App.Instance.Init() + Console.OutputEncoding = Encoding.ASCII + Console.Out.WriteLine(Core.Helpers.GetTitle) + + Dim culture As Globalization.CultureInfo = Globalization.CultureInfo.CreateSpecificCulture("en-US") + Globalization.CultureInfo.DefaultThreadCurrentCulture = culture + Globalization.CultureInfo.DefaultThreadCurrentUICulture = culture + + Dim argsErr As New Queue(Of String) + + ' ----------------------------------------- + ' Parse arguments + ' ----------------------------------------- + If args.Length > 0 Then + Dim argIdx As Integer = 0 + Do + Select Case args(argIdx).ToLower + + Case "-ll", "--log-level" + + argIdx += 1 + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for log level specification", args(argIdx))) + Continue Do + End If + + Dim intLevel As Integer = 0 + If Integer.TryParse(args(argIdx), intLevel) Then + If intLevel >= 2 AndAlso intLevel <= 9 Then + App.Instance.Settings.LogVerbosity = intLevel + End If + Else + argsErr.Enqueue(String.Format("Error : Log level specification {0} is invalid", args(argIdx))) + End If + + + + Case "-b", "--bind" + + argIdx += 1 + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for binding specification", args(argIdx))) + Continue Do + End If + + ' Ip address and port to bind to + ' Only possible form is : + + If Not args(argIdx).IndexOf(":") < 0 Then + + Dim pIpAddress As String = String.Empty + Dim pPort As String = String.Empty + Try + pIpAddress = args(argIdx).Split(":")(0) + pPort = args(argIdx).Split(":")(1) + Catch ex As Exception + End Try + + Dim tmpIpaddress As Net.IPAddress = Nothing + Dim tmpPortNumber As Integer + + If (pIpAddress = String.Empty OrElse Net.IPAddress.TryParse(pIpAddress, tmpIpaddress) = False) OrElse + (pPort = String.Empty OrElse Integer.TryParse(pPort, tmpPortNumber) = False) Then + argsErr.Enqueue(String.Format("Error : Binding address {0} is invalid", args(argIdx))) + Else + App.Instance.Settings.ListenerEndPoint = New Net.IPEndPoint(tmpIpaddress, tmpPortNumber) + End If + + Else + + Dim pPort As String = args(argIdx) + Dim tmpIpaddress As Net.IPAddress = Net.IPAddress.Any + Dim tmpPortNumber As Integer + + If (pPort = String.Empty OrElse Integer.TryParse(pPort, tmpPortNumber) = False) Then + argsErr.Enqueue(String.Format("Error : Api Binding Address {0} is invalid", args(argIdx))) + Else + App.Instance.Settings.ListenerEndPoint = New Net.IPEndPoint(tmpIpaddress, tmpPortNumber) + End If + + End If + + Case "-ab", "--api-bind" + + argIdx += 1 + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for api binding specification", args(argIdx))) + Continue Do + End If + + ' Ip address and port to bind api server to + ' Only possible form is : + + If Not args(argIdx).IndexOf(":") < 0 Then + + Dim pIpAddress As String = String.Empty + Dim pPort As String = String.Empty + Try + pIpAddress = args(argIdx).Split(":")(0) + pPort = args(argIdx).Split(":")(1) + Catch ex As Exception + End Try + + Dim tmpIpaddress As Net.IPAddress = Nothing + Dim tmpPortNumber As Integer + + If (pIpAddress = String.Empty OrElse Net.IPAddress.TryParse(pIpAddress, tmpIpaddress) = False) OrElse + (pPort = String.Empty OrElse Integer.TryParse(pPort, tmpPortNumber) = False) Then + argsErr.Enqueue(String.Format("Error : Api Binding Address {0} is invalid", args(argIdx))) + Else + App.Instance.Settings.ApiListenerEndPoint = New Net.IPEndPoint(tmpIpaddress, tmpPortNumber) + End If + + Else + + Dim pPort As String = args(argIdx) + Dim tmpIpaddress As Net.IPAddress = Net.IPAddress.Any + Dim tmpPortNumber As Integer + + If (pPort = String.Empty OrElse Integer.TryParse(pPort, tmpPortNumber) = False) Then + argsErr.Enqueue(String.Format("Error : Api Binding Address {0} is invalid", args(argIdx))) + Else + App.Instance.Settings.ApiListenerEndPoint = New Net.IPEndPoint(tmpIpaddress, tmpPortNumber) + End If + + End If + + + Case "-sp", "--stratum-pool" + + argIdx += 1 + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for stratum pool specification", args(argIdx))) + Continue Do + End If + Dim argValue As String = args(argIdx).ToLower + + ' Possible cases + ' Only pool in the form : + ' Pool with specific authentication and generic password "x" : @: + ' Pool with specific authentication and specific password : :@: + ' Pool with specific authentication and workername and specific password : .:@: + ' Pool with specific authentication and workername : .@: + + Dim patterns As String() = { + "^(?[\w\.\-]{3,})\:(?[\d,]{1,})$", + "^(?\w{1,})\@(?[\w\.\-]{3,})\:(?[\d,]{1,})$", + "^(?\w{1,})\:(?\S{1,})\@(?[\w\.\-]{3,})\:(?[\d,]{1,})$", + "^(?\w{1,})\.(?\w{1,})\:(?\S{1,})\@(?[\w\.\-]{3,})\:(?[\d,]{1,})$", + "^(?\w{1,})\.(?\w{1,})\@(?[\w\.\-]{3,})\:(?[\d,]{1,})$" + } + + Dim pHost As String = String.Empty + Dim pPorts As String = String.Empty + Dim pStratumLogin As String = String.Empty + Dim pStratumPassw As String = "x" + Dim pStratumWorker As String = String.Empty + + For patternIdx As Integer = 0 To patterns.Length - 1 + Dim matches As RegularExpressions.MatchCollection = RegularExpressions.Regex.Matches(argValue, patterns(patternIdx), RegularExpressions.RegexOptions.IgnoreCase) + If matches.Count > 0 Then + With matches(0) + If .Groups(0).Success Then + For groupIdx As Integer = 1 To .Groups.Count + If .Groups(groupIdx).Success Then + Select Case .Groups(groupIdx).Name + Case "host" + pHost = .Groups(groupIdx).Value.ToLower + Case "ports" + pPorts = .Groups(groupIdx).Value.ToLower + Case "stratumlogin" + pStratumLogin = .Groups(groupIdx).Value.Trim + Case "stratumpassword" + pStratumPassw = .Groups(groupIdx).Value.Trim + Case "workername" + pStratumWorker = .Groups(groupIdx).Value.Trim + End Select + End If + Next + End If + End With + Exit For + End If + Next + + If Not pHost = String.Empty AndAlso pHost.EndsWith("nicehash.com") = False AndAlso Not pPorts = String.Empty Then + Dim newPoolEndPoint As New Pools.Pool(pHost, Core.Helpers.PortsFromString(pPorts)) With { + .StratumLogin = pStratumLogin, + .StratumPassw = pStratumPassw, + .StratumWorker = pStratumWorker, + .IsPrimary = False, + .DevFeeAddress = GetDevAddress($"{pHost}:{Core.Helpers.PortsFromString(pPorts)(0).ToString}") + } + App.Instance.PoolMgr.AddPool(newPoolEndPoint) + Else + argsErr.Enqueue(String.Format("Error : Pool specification {0} is invalid", argValue)) + End If + + + Case "-si", "--stats-interval" + + argIdx += 1 + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for stats interval specification", args(argIdx))) + Continue Do + End If + + + Dim intLevel As Integer = 0 + If Integer.TryParse(args(argIdx), intLevel) Then + If (intLevel >= 10) Then + App.Instance.Settings.StatsInterval = intLevel + ElseIf (intLevel = 0) Then + App.Instance.Settings.StatsEnabled = False + Else + argsErr.Enqueue(String.Format("Error : Stats interval specification {0} is invalid (Min 10 seconds or 0)", args(argIdx))) + End If + Else + argsErr.Enqueue(String.Format("Error : Stats interval specification {0} is invalid (Min 10 seconds or 0)", args(argIdx))) + End If + + + Case "-sl", "--stratum-login" + + argIdx += 1 + + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for stratum login specification", args(argIdx))) + Continue Do + End If + + + ' Possible cases + ' Login only + ' Login and password + ' Login and workername and password + ' Login and workername + + Dim patterns As String() = { + "^(?\w{1,})$", + "^(?\w{1,})\:(?\S{1,})$", + "^(?\w{1,})\.(?\S{1,})\:(?\S{1,})$", + "^(?\w{1,})\.(?\S{1,})$" + } + + Dim pStratumLogin As String = String.Empty + Dim pStratumPassw As String = "x" + Dim pStratumWorker As String = String.Empty + + For patternIdx As Integer = 0 To patterns.Length - 1 + Dim matches As RegularExpressions.MatchCollection = RegularExpressions.Regex.Matches(args(argIdx), patterns(patternIdx), RegularExpressions.RegexOptions.IgnoreCase) + If matches.Count > 0 Then + With matches(0) + If .Groups(0).Success Then + For groupIdx As Integer = 1 To .Groups.Count + If .Groups(groupIdx).Success Then + Select Case .Groups(groupIdx).Name + Case "stratumlogin" + pStratumLogin = .Groups(groupIdx).Value.Trim + Case "stratumpassword" + pStratumPassw = .Groups(groupIdx).Value.Trim + Case "workername" + pStratumWorker = .Groups(groupIdx).Value.Trim + End Select + End If + Next + End If + End With + Exit For + End If + Next + + If Not pStratumLogin = String.Empty Then + App.Instance.Settings.PoolsStratumLogin = pStratumLogin + App.Instance.Settings.PoolsStratumPassword = pStratumPassw + App.Instance.Settings.PoolsStratumWorker = pStratumWorker + Else + argsErr.Enqueue(String.Format("Error : Stratum Login {0} is invalid", args(argIdx))) + End If + + Case "-rh", "--report-hashrate" + + App.Instance.Settings.PoolsReportHashRate = True + + Case "-rw", "--report-workers" + + App.Instance.Settings.PoolsReportWorkerNames = True + + Case "-nc", "--no-console" + + App.Instance.Settings.NoConsole = True + + Case "-np", "--no-probe" + + App.Instance.Settings.PoolsNoProbe = True + + Case "--no-fee" + + App.Instance.Settings.NoFee = True + + Case "-wt", "--work-timeout" + + argIdx += 1 + + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for work timeout specification", args(argIdx))) + Continue Do + End If + + Dim intLevel As Integer = 0 + If Integer.TryParse(args(argIdx), intLevel) Then + If (intLevel >= 30 AndAlso intLevel <= 300) Then + App.Instance.Settings.PoolsWorkTimeout = intLevel + End If + Else + argsErr.Enqueue(String.Format("Error : Work Timeout specification {0} is invalid (Min 30 Max 300 seconds)", args(argIdx))) + End If + + Case "-ws", "--workers-spacing" + + argIdx += 1 + + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for workers spacing specification", args(argIdx))) + Continue Do + End If + + Dim intLevel As Integer = 0 + If Integer.TryParse(args(argIdx), intLevel) Then + If (intLevel >= 16 AndAlso intLevel <= 40) Then + App.Instance.Settings.WorkersSpacing = intLevel + End If + Else + argsErr.Enqueue(String.Format("Error : Workers spacing specification {0} is invalid (Min 16 Max 40)", args(argIdx))) + End If + + Case "-rt", "--response-timeout" + + argIdx += 1 + If (argIdx >= args.Length) Then + argsErr.Enqueue(String.Format("Error : Missing value for response timeout specification", args(argIdx))) + Continue Do + End If + + Dim intLevel As Integer = 0 + If Integer.TryParse(args(argIdx), intLevel) Then + If (intLevel >= 10 AndAlso intLevel <= 30000) Then + App.Instance.Settings.PoolsResponseTimeout = intLevel + End If + Else + argsErr.Enqueue(String.Format("Error : Response Timeout specification {0}ms is invalid (Min 10 Max 30000 ms)", args(argIdx))) + End If + + + Case "-h", "--help" + + Console.Out.WriteLine(Core.GetHelpText) + Environment.Exit(0) + + Case Else + + argsErr.Enqueue(String.Format("Error : Unknown command argument {0}", args(argIdx))) + + End Select + argIdx += 1 + Loop While argIdx < args.Length + End If + + ' ----------------------------------------- + ' Validate arguments + ' ----------------------------------------- + With App.Instance.PoolMgr + + If .PoolsQueue.Where(Function(p) p.IsValid).Count < 1 Then + argsErr.Enqueue("Error : No valid pools available for connection") + End If + + If .StratumLogin = String.Empty Then + If .PoolsQueue.Where(Function(p) p.StratumLogin <> String.Empty).Count < 1 Then + argsErr.Enqueue("Error : No valid stratum logins were found") + End If + End If + + End With + + + If argsErr.Count > 0 Then + Do While argsErr.Count > 0 + Console.Error.WriteLine(argsErr.Dequeue) + Loop + Console.Out.WriteLine("Try using --help") + Console.Out.WriteLine("Terminating ...") + Environment.Exit(ExitCodes.ArgumentsError) + End If + + ' ----------------------------------------- + ' Check DevFee is set + ' ----------------------------------------- + If App.Instance.PoolMgr.PoolsQueue.Where(Function(p) String.IsNullOrEmpty(p.DevFeeAddress) = True).Count > 0 Then + App.Instance.Settings.NoFee = True + Console.WriteLine(" One or more pools not available for donation fee.") + Console.WriteLine(" Setting --no-fee") + End If + If App.Instance.Settings.NoFee = True Then + Console.WriteLine(" --no-fee is set. No developer fee will be applied.") + Console.WriteLine(" Developer looses all his revenues.") + Console.WriteLine(" This proxy will NOT do any optimization.") + Console.WriteLine(" ") + Else + + Console.WriteLine($" Developer fee set to {Helpers.DONATE_LEVEL * 100}%. Thank you.") + Console.WriteLine(" ") + End If + + + ' ----------------------------------------- + ' Start + ' ----------------------------------------- + StartProxy() + Environment.Exit(ExitCodes.Success) + + End Sub + + Sub StartProxy() + + ' Start working + ' ThreadPool.QueueUserWorkItem(New Threading.WaitCallback(AddressOf App.Start)) + ' Dim thListener As Threading.Thread = New Threading.Thread(AddressOf App.PoolMgr.Start) + App.Instance.Start() + + 'thListener.Start() + If App.Instance.Settings.NoConsole Then + + AddHandler AssemblyLoadContext.Default.Unloading, AddressOf OnSignalReceived + signalReceived.Wait() + Logger.Log(0, "Signal intercepted ...", "Main") + terminated.Wait() + + Else + + Do + + If Console.KeyAvailable Then + Dim keyPressed As ConsoleKeyInfo = Console.ReadKey(True) + Select Case True + + Case keyPressed.Key = ConsoleKey.Q + + ' Quit + Logger.Log(0, "Shutting down ...") + App.Instance.Stop() + Logger.Log(0, "All done !") + Exit Do + + Case keyPressed.Key = ConsoleKey.S + + ' Switch pool + Logger.Log(0, "Switching pool ...") + App.Instance.PoolMgr.SwitchPool() + + Case keyPressed.Key = ConsoleKey.R + + ' Reconnect + Logger.Log(0, "Reconnecting ...") + App.Instance.PoolMgr.Reconnect() + + Case keyPressed.Key = ConsoleKey.Subtract + + ' Decrease log verbosity + If App.Instance.Settings.LogVerbosity > 1 Then + Interlocked.Decrement(App.Instance.Settings.LogVerbosity) + End If + Logger.Log(0, "Log verbosity set to " + App.Instance.Settings.LogVerbosity.ToString) + + Case keyPressed.Key = ConsoleKey.Add + + ' Increase log verbosity + If App.Instance.Settings.LogVerbosity < 9 Then + Interlocked.Increment(App.Instance.Settings.LogVerbosity) + End If + Logger.Log(0, "Log verbosity set to " + App.Instance.Settings.LogVerbosity.ToString) + + Case Else + Logger.Log(0, "Unrecongnized input key command") + End Select + End If + Thread.Sleep(100) + Loop + + End If + + + End Sub + + Public Sub OnSignalReceived(e As AssemblyLoadContext) + + signalReceived.Set() + + Logger.Log(0, "Shutting down ...") + App.Instance.Stop() + Logger.Log(0, "All done !") + + terminated.Set() + + + End Sub + +End Module diff --git a/RangeTree/IRangeProvider.vb b/RangeTree/IRangeProvider.vb new file mode 100644 index 0000000..61bb3ce --- /dev/null +++ b/RangeTree/IRangeProvider.vb @@ -0,0 +1,31 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace RangeTree + + ''' + ''' Interface for classes which provide a Range + ''' + Public Interface IRangeProvider(Of T As IComparable(Of T)) + + Property Range As Range(Of T) + + End Interface + +End Namespace diff --git a/RangeTree/IRangeTree.vb b/RangeTree/IRangeTree.vb new file mode 100644 index 0000000..5a085d2 --- /dev/null +++ b/RangeTree/IRangeTree.vb @@ -0,0 +1,45 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace RangeTree + + ''' + ''' Range tree interface. + ''' + ''' The type of the range + ''' The type of the data items + Public Interface IRangeTree(Of TKey As IComparable(Of TKey), T As IRangeProvider(Of TKey)) + + ReadOnly Property Items As IEnumerable(Of T) + ReadOnly Property Count As Integer + + Function Query(value As TKey) As List(Of T) + Function Query(value As Range(Of TKey)) As List(Of T) + + Sub Rebuild() + Sub Add(item As T) + Sub Add(items As IEnumerable(Of T)) + Sub Remove(item As T) + Sub Remove(items As IEnumerable(Of T)) + Sub Clear() + + End Interface + +End Namespace + diff --git a/RangeTree/Range.vb b/RangeTree/Range.vb new file mode 100644 index 0000000..7c19529 --- /dev/null +++ b/RangeTree/Range.vb @@ -0,0 +1,260 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace RangeTree + + ''' + ''' Represents a range of values. Both values must be of same type and comparable. + ''' + ''' The Type of the values + Public Class Range(Of T As IComparable(Of T)) + Implements IComparable(Of Range(Of T)) + +#Region " Private Members" + + Private _from As T + Private _to As T + +#End Region + +#Region " Properties" + + ''' + ''' Gets the starting value of the range + ''' + Public ReadOnly Property From As T + Get + Return _from + End Get + End Property + + ''' + ''' Gets the ending value of the range + ''' + Public ReadOnly Property [To] As T + Get + Return _to + End Get + End Property + +#End Region + +#Region " Constructor" + + ''' + ''' Initializes a new instance of the class. + ''' + ''' The value. + Public Sub New(value As T) + Me.New(value, value) + End Sub + + ''' + ''' Initializes a new instance of the class. + ''' + ''' The range from (start). + ''' The range to (end). + Public Sub New(from As T, [to] As T) + + If from.CompareTo([to]) = 1 Then + Throw New ArgumentOutOfRangeException($"{NameOf(from)} cannot be greater than {NameOf([to])}") + End If + + _from = from + _to = [to] + + End Sub + +#End Region + +#Region " Methods" + + ''' + ''' Determines whether the value is contained in the range. Border values are considered inside. + ''' + ''' The value + ''' + ''' true if [contains] [the specified value]; otherwise, false. + ''' + Public Function Contains(value As T) + + Return value.CompareTo(From) >= 0 AndAlso value.CompareTo([To]) <= 0 + + End Function + + ''' + ''' Determines whether the value is contained in the range. Border values are considered outside. + ''' + ''' The value + ''' + ''' true if [contains] [the specified value]; otherwise, false. + ''' + Public Function ContainsExclusive(value As T) + + Return value.CompareTo(From) > 0 AndAlso value.CompareTo([To]) < 0 + + End Function + + ''' + ''' Whether two ranges intersect each other. + ''' + ''' The to check intersection with. + ''' [True] if intesecting, otherwise [False] + Public Function Intersects(other As Range(Of T)) + + Return other.To.CompareTo(From) >= 0 AndAlso other.From.CompareTo([To]) <= 0 + + End Function + + ''' + ''' Whether two ranges intersect each other. Borders are considered outside + ''' + ''' The to check intersection with. + ''' [True] if intesecting, otherwise [False] + Public Function IntersectsExclusive(other As Range(Of T)) + + Return other.To.CompareTo(From) > 0 AndAlso other.From.CompareTo([To]) < 0 + + End Function + + ''' + ''' Determines whether the specified object is equal to the current object. + ''' + ''' The object to compare with the current object. + ''' True or False + Public Overrides Function Equals(obj As Object) As Boolean + + Dim r As Range(Of T) = DirectCast(obj, Range(Of T)) + + If r Is Nothing Then + Return False + End If + + Return r.From.Equals(From) AndAlso r.To.Equals([To]) + + End Function + + ''' + ''' Returns a that represents this instance. + ''' + ''' A + Public Overrides Function ToString() As String + + Return String.Format("{0} - {1}", From, [To]) + + End Function + + ''' + ''' Returns a hash code for this instance. + ''' + Public Overrides Function GetHashCode() As Integer + + Dim hash As Integer = 23 + hash = (hash * 37) + From.GetHashCode() + hash = (hash * 37) + [To].GetHashCode() + Return hash + + End Function + +#End Region + + +#Region " IComparable" + + ''' + ''' Compares the current instance with another object of the same type and returns an integer that + ''' indicates whether the current instance precedes, follows, or occurs in the same position + ''' in the sort order as the other object. + ''' + ''' An object to compare with this instance. + ''' + Public Function CompareTo(other As Range(Of T)) As Integer Implements IComparable(Of Range(Of T)).CompareTo + + + If ([To].CompareTo(other.From) < 0) Then + + ' This +-----------+ + ' Other +-----------+ + + Return -1 + + ElseIf ([to].CompareTo(other.From)) > 0 Then + + + ' This +-----------+ + ' Other +-----------+ + + ' This +-----------+ + ' Other +------+ + + + Return From.CompareTo(other.From) + + ElseIf (other.From.CompareTo(From)) = 0 Then + + ' This +-----------+ + ' Other +------+ + + ' This +-----------+ + ' Other +--------------+ + + + Return [To].CompareTo(other.To) + + ElseIf (other.To.CompareTo(From)) < 0 Then + + ' This +-----------+ + ' Other +-----------+ + + Return 1 + + ElseIf (other.To.CompareTo(from) > 0) Then + + ' This +-----------+ + ' Other +-----------+ + + ' This +----+ + ' Other +-----------+ + + Return other.To.CompareTo([To]) + + + End If + + Return 0 + + 'If (From.CompareTo(other.From) < 0) Then + ' Return -1 + 'ElseIf (From.CompareTo(other.From) > 0) Then + ' Return 1 + 'ElseIf ([To].CompareTo(other.To) < 0) Then + ' Return -1 + 'ElseIf ([To].CompareTo(other.To) > 0) Then + ' Return 1 + 'Else + ' Return 0 + 'End If + + End Function + + End Class + +#End Region + +End Namespace diff --git a/RangeTree/RangeTree.vb b/RangeTree/RangeTree.vb new file mode 100644 index 0000000..ac263d8 --- /dev/null +++ b/RangeTree/RangeTree.vb @@ -0,0 +1,231 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace RangeTree + + Public Class RangeTree(Of TKey As IComparable(Of TKey), T As IRangeProvider(Of TKey)) + Implements IRangeTree(Of TKey, T) + +#Region " Private Members" + + Private root As RangeTreeNode(Of TKey, T) + Private _items As List(Of T) + Private _isInSync As Boolean + Private _autoRebuild As Boolean + Private _rangeComparer As IComparer(Of T) + +#End Region + +#Region " Constructor" + + ''' + ''' Initializes a new instance of + ''' + ''' The Range Comparer + Public Sub New(rangeComparer As IComparer(Of T)) + + _rangeComparer = rangeComparer + root = New RangeTreeNode(Of TKey, T)(rangeComparer) + _items = New List(Of T) + _isInSync = True + _autoRebuild = True + + End Sub + + ''' + ''' Initializes a new instance of + ''' + ''' The initial list of items + ''' The Range Comparer + Public Sub New(items As IEnumerable(Of T), rangeComparer As IComparer(Of T)) + + _rangeComparer = rangeComparer + root = New RangeTreeNode(Of TKey, T)(items, rangeComparer) + _items = items.ToList() + _isInSync = True + _autoRebuild = True + + End Sub + + +#End Region + +#Region " Properties" + + ''' + ''' Gets a value indicating whether the tree is currently in sync or not. + ''' If it is "out of sync" you can either rebuild it manually (call Rebuild) + ''' or let it rebuild automatically when you query it next. + ''' + ''' True / False + Public ReadOnly Property IsInSync As Boolean + Get + Return _isInSync + End Get + End Property + + ''' + ''' Gets all of the tree items. + ''' + ''' + Public ReadOnly Property Items As IEnumerable(Of T) Implements IRangeTree(Of TKey, T).Items + Get + Return _items + End Get + End Property + + ''' + ''' Gets the total number of items + ''' + ''' + Public ReadOnly Property Count As Integer Implements IRangeTree(Of TKey, T).Count + Get + Return _items.Count + End Get + End Property + + ''' + ''' Gets the median of this Tree + ''' + ''' + Public ReadOnly Property Center As TKey + Get + Return root.Center + End Get + End Property + + +#End Region + +#Region " Methods" + + ''' + ''' Rebuilds the tree if it is out of sync. + ''' + Public Sub Rebuild() Implements IRangeTree(Of TKey, T).Rebuild + + If _isInSync Then Return + root = New RangeTreeNode(Of TKey, T)(_items, _rangeComparer) + _isInSync = True + + End Sub + + ''' + ''' Adds the specified item. Tree will go out of sync. + ''' + ''' The item to add + Public Sub Add(item As T) Implements IRangeTree(Of TKey, T).Add + + SyncLock root + _isInSync = False + _items.Add(item) + End SyncLock + + End Sub + + ''' + ''' Adds the specified list of items. Tree will go out of sync. + ''' + ''' + Public Sub Add(items As IEnumerable(Of T)) Implements IRangeTree(Of TKey, T).Add + + SyncLock root + _isInSync = False + _items.AddRange(items) + End SyncLock + + + End Sub + + ''' + ''' Removes the specified item. Tree will go out of sync + ''' + ''' + Public Sub Remove(item As T) Implements IRangeTree(Of TKey, T).Remove + + SyncLock root + _isInSync = False + _items.Remove(item) + End SyncLock + + End Sub + + ''' + ''' Removes the specified list of items. Tree will go out of sync + ''' + ''' + Public Sub Remove(items As IEnumerable(Of T)) Implements IRangeTree(Of TKey, T).Remove + + SyncLock root + _isInSync = False + For Each i As T In items + _items.Remove(i) + Next + End SyncLock + + End Sub + + ''' + ''' Clears the tree + ''' + Public Sub Clear() Implements IRangeTree(Of TKey, T).Clear + + root = New RangeTreeNode(Of TKey, T)(_rangeComparer) + SyncLock root + _items.Clear() + _isInSync = True + End SyncLock + + End Sub + + ''' + ''' Performs a "stab" query with a single value. All items with overlapping ranges are returned. + ''' + ''' The value to search for + ''' All matching results as + Public Function Query(value As TKey) As List(Of T) Implements IRangeTree(Of TKey, T).Query + + If (_isInSync = False AndAlso _autoRebuild = True) Then + Rebuild() + End If + + Return root.Query(value) + + End Function + + ''' + ''' Performs a "stab" query with a single range value. All items with overlapping ranges are returned. + ''' + ''' The value to search for + ''' All matching results as + Public Function Query(value As Range(Of TKey)) As List(Of T) Implements IRangeTree(Of TKey, T).Query + + If (_isInSync = False AndAlso _autoRebuild = True) Then + Rebuild() + End If + + Return root.Query(value) + + End Function + +#End Region + + End Class + +End Namespace diff --git a/RangeTree/RangeTreeNode.vb b/RangeTree/RangeTreeNode.vb new file mode 100644 index 0000000..27aee9f --- /dev/null +++ b/RangeTree/RangeTreeNode.vb @@ -0,0 +1,211 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace RangeTree + + ''' + ''' A node of the range tree. Given a list of items, it builds its subtree. + ''' Also contains methods to query the subtree. Basically, all interval tree logic is here. + ''' + ''' The type of + ''' The type of + Public Class RangeTreeNode(Of TKey As IComparable(Of TKey), T As IRangeProvider(Of TKey)) + +#Region " Private members" + + Private _center As TKey + Private _lNode As RangeTreeNode(Of TKey, T) + Private _rNode As RangeTreeNode(Of TKey, T) + Private _items As List(Of T) + + Private _rangeComparer As IComparer(Of T) + +#End Region + +#Region " Properties" + + Public ReadOnly Property RangeComparer As IComparer(Of T) + Get + Return _rangeComparer + End Get + End Property + + ''' + ''' Gets the median value of this tree + ''' + ''' + Public ReadOnly Property Center As TKey + Get + Return _center + End Get + End Property + +#End Region + +#Region " Constructor" + + ''' + ''' Initializes a new instance of the class. + ''' + ''' The Range comparer + Public Sub New(Optional rangeComparer As IComparer(Of T) = Nothing) + + If rangeComparer IsNot Nothing Then + _rangeComparer = rangeComparer + End If + + _center = Nothing + _lNode = Nothing + _rNode = Nothing + _items = Nothing + + End Sub + + ''' + ''' Initializes a new instance of the class. + ''' + ''' An existing list of items + ''' The Range Comparer + Public Sub New(items As IEnumerable(Of T), Optional rangeComparer As IComparer(Of T) = Nothing) + + If rangeComparer IsNot Nothing Then + _rangeComparer = rangeComparer + End If + + Dim endPoints As New List(Of TKey) + + For Each i As T In items + endPoints.Add(i.Range.From) + endPoints.Add(i.Range.To) + Next + endPoints.Sort() + + ' Use the median as center value + If (endPoints.Count > 0) Then + _center = endPoints(endPoints.Count / 2) + End If + + _items = New List(Of T) + Dim l As New List(Of T) + Dim r As New List(Of T) + + ' Iterate over all items + ' if the range of an item is completely left of the center, add it to the left items + ' if it is on the right of the center, add it to the right items + ' otherwise (range overlaps the center), add the item to this node's items + For Each i As T In items + + If i.Range.To.CompareTo(_center) < 0 Then + + ' Range ends to the left + l.Add(i) + + ElseIf i.Range.From.CompareTo(_center) > 0 Then + + ' Range starts to the right + r.Add(i) + Else + + ' Range intersects this median + _items.Add(i) + + End If + + Next + + ' Sort items to speed up later queries + If _items.Count > 0 Then + _items.Sort(_rangeComparer) + Else + _items = Nothing + End If + + ' Create left and right nodes if any + If l.Count > 0 Then _lNode = New RangeTreeNode(Of TKey, T)(l, _rangeComparer) + If r.Count > 0 Then _rNode = New RangeTreeNode(Of TKey, T)(r, _rangeComparer) + + End Sub + + ''' + ''' Performans a "stab" query with a single value. All items with overlapping ranges are returned. + ''' + ''' The value to search + ''' The resulting matches as + Public Function Query(value As TKey) As List(Of T) + + Dim results As New List(Of T) + + ' If the node has items check ranges + If _items IsNot Nothing Then + For Each i As T In _items + If i.Range.Contains(value) Then + results.Add(i) + End If + Next + End If + + ' Go to the left or go to the right of the tree, depending + ' where the query value lies compared to the center + If (value.CompareTo(_center) < 0 AndAlso _lNode IsNot Nothing) Then + results.AddRange(_lNode.Query(value)) + End If + If (value.CompareTo(_center) > 0 AndAlso _rNode IsNot Nothing) Then + results.AddRange(_rNode.Query(value)) + End If + + Return results + + End Function + + ''' + ''' Performs a range query. All items with overlapping ranges are returned. + ''' + ''' The Range to search + ''' The resulting matches as + Public Function Query(value As Range(Of TKey)) As List(Of T) + + Dim results As New List(Of T) + + ' If the node has items, check their ranges. + If _items IsNot Nothing Then + For Each i As T In _items + If (i.Range.Intersects(value)) Then + results.Add(i) + End If + Next + End If + + ' Go to the left or go to the right of the tree, depending + ' where the query value lies compared to the center + If (value.To.CompareTo(_center) < 0 AndAlso _lNode IsNot Nothing) Then + results.AddRange(_lNode.Query(value)) + End If + If (value.From.CompareTo(_center) > 0 AndAlso _rNode IsNot Nothing) Then + results.AddRange(_rNode.Query(value)) + End If + + Return results + + End Function + +#End Region + + End Class + +End Namespace diff --git a/RangeTree/WorkerRange.vb b/RangeTree/WorkerRange.vb new file mode 100644 index 0000000..12ae19d --- /dev/null +++ b/RangeTree/WorkerRange.vb @@ -0,0 +1,47 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Namespace RangeTree + + ''' + ''' Represents the working range of a single miner (or worker) + ''' + Public Class WorkerRangeItem + Implements IRangeProvider(Of UInt64) + + Public Property TimeStamp As DateTime = DateTime.Now + Public Property Id As String + Public Property Name As String + Public Property Range As Range(Of UInt64) Implements IRangeProvider(Of UInt64).Range + + End Class + + ''' + ''' Represents the comparer among Workers Ranges + ''' + Public Class WorkerRangeItemComparer + Implements IComparer(Of WorkerRangeItem) + + Public Function Compare(x As WorkerRangeItem, y As WorkerRangeItem) As Integer Implements IComparer(Of WorkerRangeItem).Compare + Return x.Range.CompareTo(y.Range) + End Function + + End Class + +End Namespace diff --git a/Sockets/AsyncSocket.vb b/Sockets/AsyncSocket.vb new file mode 100644 index 0000000..740c455 --- /dev/null +++ b/Sockets/AsyncSocket.vb @@ -0,0 +1,707 @@ +' ======================================================================================= +' +' This file is part of neth-proxy. +' +' neth-proxy is free software: you can redistribute it and/or modify +' it under the terms Of the GNU General Public License As published by +' the Free Software Foundation, either version 3 Of the License, Or +' (at your option) any later version. +' +' neth-proxy 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. See the +' GNU General Public License For more details. +' +' You should have received a copy Of the GNU General Public License +' along with neth-proxy. If not, see < http://www.gnu.org/licenses/ >. +' +' ======================================================================================= + +Imports nethproxy.Core +Imports System.Json +Imports System.Net +Imports System.Net.Sockets +Imports System.Text +Imports System.Threading + + +Namespace Sockets + + ''' + ''' This is the base class which all socket-handling objects inherit from + ''' + Public Class AsyncSocket + Implements IDisposable + +#Region " Fields" + + ' Socket related members + Protected _connectionStatus As AsyncSocketStatus = AsyncSocketStatus.NotConnected + Protected _connectionSocket As Socket + Protected _connectionRemoteEndPoint As IPEndPoint + Protected _connectionLocalEndPoint As IPEndPoint + Protected _dataBuffer As String = String.Empty + + Protected _context As String + + ' Async events members + Protected _asyncConnArgs As SocketAsyncEventArgs + Protected _asyncReadArgs As SocketAsyncEventArgs + Protected _asyncSendArgs As New Concurrent.ConcurrentStack(Of SocketAsyncEventArgs) + Protected _asyncActiveSends As Integer = 0 + + Protected Shared _lockObj As New Object + + ' Activity timestamps + Protected _lastInboundTimeStamp As DateTime = DateTime.MinValue ' Records timestamp of last successfully sent message + Protected _lastOutboundTimeStamp As DateTime = DateTime.MinValue ' Records timestamp of last successfully received message + Protected _connectedTimeStamp As DateTime = DateTime.MinValue ' Records effective timestamp of connection + +#End Region + +#Region " Constructor" + + ''' + ''' Standard constructor + ''' + Public Sub New(Optional context As String = "Socket") + _context = context + End Sub + + ''' + ''' Creates a new instance with an already existing + ''' + ''' An already existing object + Public Sub New(ByRef fromSocket As Socket, Optional context As String = "Socket") + _context = context + _connectionSocket = fromSocket + If _connectionSocket.Connected() Then Call OnConnected() + End Sub + +#End Region + +#Region " Events" + + Public Event Connected(ByRef sender As Object) + Public Event ConnectionFailed(ByRef sender As Object) + Public Event Disconnected(ByRef sender As Object) + Public Event MessageReceived(ByRef sender As Object, ByVal Message As String) + Public Event SendFailed(ByRef sender As Object) + Public Event ReceiveFailed(ByRef sender As Object) + +#End Region + +#Region " Properties" + + ''' + ''' Gets wether or not this socket is connected + ''' + ''' True Or False + Public ReadOnly Property IsConnected + Get + If _connectionSocket Is Nothing Then Return False + Return (_connectionStatus.HasFlags({AsyncSocketStatus.Connected}) AndAlso Not IsPendingState) + End Get + End Property + + ''' + ''' Gets wether or not this socket is in pending connection/disconnection operations + ''' + ''' + Public ReadOnly Property IsPendingState As Boolean + Get + Return _connectionStatus.HasAnyFlag({AsyncSocketStatus.Disconnecting, AsyncSocketStatus.Connecting}) + End Get + End Property + + ''' + ''' Gets the active local endpoint + ''' + ''' An object or Nothing + Public ReadOnly Property LocalEndPoint() As IPEndPoint + Get + Return _connectionLocalEndPoint + End Get + End Property + + ''' + ''' Gets the active remote endpoint + ''' + ''' An object or Nothing + Public ReadOnly Property RemoteEndPoint() As IPEndPoint + Get + Return _connectionRemoteEndPoint + End Get + End Property + + ''' + ''' Gets timestamp of last succesfully received message + ''' + ''' A + Public ReadOnly Property LastInboundTimeStamp As DateTime + Get + Return _lastInboundTimeStamp + End Get + End Property + + ''' + ''' Gets timestamp of last successfully received message + ''' + ''' A + Public ReadOnly Property LastOutboundTimeStamp As DateTime + Get + Return _lastOutboundTimeStamp + End Get + End Property + + ''' + ''' Gets the duration this socket has been Idle + ''' + ''' A + Public ReadOnly Property IdleDuration As TimeSpan + Get + If _lastInboundTimeStamp >= _lastOutboundTimeStamp Then + Return DateTime.Now.Subtract(_lastInboundTimeStamp) + Else + Return DateTime.Now.Subtract(_lastOutboundTimeStamp) + End If + End Get + End Property + + ''' + ''' Gets timestamp of connection + ''' + ''' + Public ReadOnly Property ConnectedTimestamp As DateTime + Get + Return _connectedTimeStamp + End Get + End Property + + ''' + ''' Gets the duration of this connection + ''' + ''' A object + Public ReadOnly Property ConnectionDuration As TimeSpan + Get + If _connectedTimeStamp = DateTime.MinValue Then + Return New TimeSpan(0, 0, 0) + End If + Return DateTime.Now.Subtract(_connectedTimeStamp) + End Get + End Property + + ''' + ''' Gets Timestamp of last successful message (in or out) + ''' + ''' + Public ReadOnly Property LastActivityTimestamp As DateTime + Get + If _lastInboundTimeStamp > _lastOutboundTimeStamp Then + Return _lastInboundTimeStamp + Else + Return _lastOutboundTimeStamp + End If + End Get + End Property + +#End Region + +#Region " Handlers" + + ''' + ''' Occurs immediately after a succesful connection + ''' + Private Sub OnConnected() + + _connectedTimeStamp = DateTime.Now + + With _connectionStatus + .SetFlags({AsyncSocketStatus.Connected}) + .UnsetFlags({AsyncSocketStatus.Connecting, AsyncSocketStatus.NotConnected}) + End With + + With _connectionSocket + .LingerState = New LingerOption(False, 0) + .SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.KeepAlive, True) + .SetSocketOption(SocketOptionLevel.Tcp, SocketOptionName.NoDelay, True) + _connectionRemoteEndPoint = ConvertToIPEndPoint(.RemoteEndPoint) + _connectionLocalEndPoint = ConvertToIPEndPoint(.LocalEndPoint) + End With + + SetKeepAlive(_connectionSocket, 300000, 30000) + + ' Raise event + If ConnectedEvent IsNot Nothing Then RaiseEvent Connected(Me) + + End Sub + + ''' + ''' Occurs immediately after a failed connection attempt + ''' + Private Sub OnConnectionFailed() + + _connectionStatus.UnsetFlags({AsyncSocketStatus.Connecting}) + _connectionSocket = Nothing + + ' Raise event + If ConnectionFailedEvent IsNot Nothing Then RaiseEvent ConnectionFailed(Me) + + End Sub + + ''' + ''' Occurs immediately after a disconnection + ''' + Private Sub OnDisconnected() + + + ' Signal Status of connection + SyncLock _lockObj + _connectionStatus.UnsetFlags({AsyncSocketStatus.Disconnecting, AsyncSocketStatus.Connected}) + _connectionStatus.SetFlags({AsyncSocketStatus.NotConnected}) + End SyncLock + + _connectedTimeStamp = DateTime.MinValue + _lastInboundTimeStamp = DateTime.MinValue + _lastOutboundTimeStamp = DateTime.MinValue + _connectionSocket = Nothing + + Logger.Log(7, String.Format("Disconnected from {0}", _connectionRemoteEndPoint), _context) + + ' Empty data buffer and AsyncSocketEventargs + _dataBuffer = String.Empty + FlushSendArgs() + + ' Raise event + If DisconnectedEvent IsNot Nothing Then RaiseEvent Disconnected(Me) + + End Sub + + +#End Region + + +#Region " Socket Operations" + + ''' + ''' Starts receiving asynchronously from socket + ''' + Public Sub BeginReceive() + + If Not IsConnected Then Return + + If _asyncReadArgs Is Nothing Then + _asyncReadArgs = New SocketAsyncEventArgs With {.RemoteEndPoint = RemoteEndPoint} + AddHandler _asyncReadArgs.Completed, AddressOf OnAsyncIOCompleted + _asyncReadArgs.SetBuffer(New Byte(DEFAULT_BUFFER_SIZE) {}, 0, DEFAULT_BUFFER_SIZE) + End If + + Try + + If Not (_connectionSocket.ReceiveAsync(_asyncReadArgs)) Then + OnAsyncIOCompleted(_connectionSocket, _asyncReadArgs) + End If + + Catch ex As Exception + + ' Another receiving operation is already pending + ' This should not happen. Disconnect client + Disconnect() + + End Try + + End Sub + + ''' + ''' Starts a connection to remote endpoint + ''' + Public Sub Connect(ByRef toEndPoint As IPEndPoint) + + If IsConnected OrElse IsPendingState Then Return + + _connectionStatus.SetFlags({AsyncSocketStatus.Connecting}) + _connectionSocket = New Socket(toEndPoint.AddressFamily, SocketType.Stream, ProtocolType.Tcp) + + If _asyncConnArgs Is Nothing Then + _asyncConnArgs = New SocketAsyncEventArgs + AddHandler _asyncConnArgs.Completed, AddressOf OnAsyncIOCompleted + End If + _asyncConnArgs.RemoteEndPoint = toEndPoint + + If Not _connectionSocket.ConnectAsync(_asyncConnArgs) Then + OnAsyncIOCompleted(_connectionSocket, _asyncConnArgs) + End If + + End Sub + + ''' + ''' Performs clean disconnect of socket + ''' + Public Sub Disconnect() + + If Not IsConnected OrElse IsPendingState Then Return + + _connectionStatus.SetFlags({AsyncSocketStatus.Disconnecting}) + + Try + + SyncLock _lockObj + _connectionStatus.SetFlags({AsyncSocketStatus.Disconnecting}) + _connectionSocket.Shutdown(SocketShutdown.Both) + _connectionSocket.Disconnect(False) + _connectionSocket.Close(500) + _connectionSocket = Nothing + End SyncLock + + Catch ex As Exception + + Logger.Log(0, String.Format("Error while closing connection with {0} : {1}", _connectionRemoteEndPoint, ex.GetBaseException.Message), _context) + + End Try + + OnDisconnected() + + + End Sub + + ''' + ''' Reads messages stored in buffer and processes them one by one + ''' + Private Sub QueueData() + + ' Split accumulated data in messages separated by newLine char + Static offset As Integer = 0 + Static message As String = String.Empty + + offset = 0 + message = String.Empty + + Do While (offset >= 0 AndAlso _dataBuffer.Length > 0) + + offset = _dataBuffer.IndexOf(ChrW(10), 0) + If offset >= 0 Then + message = _dataBuffer.Substring(0, offset) + _dataBuffer = _dataBuffer.Remove(0, offset + 1) + If MessageReceivedEvent IsNot Nothing Then RaiseEvent MessageReceived(Me, message) + End If + + Loop + + End Sub + + ''' + ''' Gets data from the Socket + ''' + Private Sub ReceiveSocketData(e As SocketAsyncEventArgs) + + If (Not IsConnected OrElse (e Is Nothing)) Then + Return + End If + + 'If BytesTransferred is 0, then the remote endpoint closed the connection + If (e.SocketError = SocketError.Success) Then + + If e.BytesTransferred > 0 Then + + ' Append transferred data to dataBuffer + _dataBuffer += Encoding.ASCII.GetString(e.Buffer, e.Offset, e.BytesTransferred) + + ' If the read socket is empty, we can do something with the data that we accumulated + ' from all of the previous read requests on this socket + If (_connectionSocket.Available = 0) Then + Call QueueData() + End If + + ' Start another receive request and immediately check to see if the receive is already complete + ' Otherwise OnClientIOCompleted will get called when the receive is complete + ' We are basically calling this same method recursively until there is no more data + ' on the read socket + Try + If _connectionSocket IsNot Nothing AndAlso Not _connectionSocket.ReceiveAsync(e) Then + OnAsyncIOCompleted(_connectionSocket, e) + End If + Catch ex As Exception + Disconnect() + End Try + + Else + + Logger.Log(7, String.Format("{0} remotely closed connection", RemoteEndPoint.ToString), _context) + + ' Gracefully closes resources + Disconnect() + + End If + + + Else + + If e.SocketError <> SocketError.OperationAborted Then + Logger.Log(0, String.Format("{0} socket error : {1}", RemoteEndPoint.ToString, [Enum].GetName(GetType(SocketError), e.SocketError).ToString()), _context) + End If + + ' Gracefully closes resources + Disconnect() + + End If + + End Sub + + ''' + ''' Sends data to socket + ''' + ''' The mesasge to be sent + ''' Lf separator is automatically added + Public Sub Send(message As String) + + If Not IsConnected Then Return + + Dim sendArg As SocketAsyncEventArgs = GetSendArg() + Dim sendBuffer As Byte() = Encoding.ASCII.GetBytes(message + ChrW(10)) + sendArg.SetBuffer(sendBuffer, 0, sendBuffer.Length) + + ' If operation is ran synchronously immediately reuse asyncEvent + Try + If Not _connectionSocket.SendAsync(sendArg) Then + OnAsyncIOCompleted(_connectionSocket, sendArg) + End If + Catch ex As Exception + Logger.Log(0, String.Format("Failed to send : {0}", ex.GetBaseException.Message), _context) + End Try + + End Sub + + ''' + ''' Sends data to socket + ''' + ''' A + ''' Lf separator is automatically added + Public Sub Send(jsonMessage As JsonObject) + Send(message:=jsonMessage.ToString) + End Sub + +#End Region + +#Region " Helpers" + + ''' + ''' Gets a SocketAsyncEventArg if available or creates one + ''' + ''' An object + Private Function GetSendArg() As SocketAsyncEventArgs + + Dim retVar As SocketAsyncEventArgs = Nothing + + If _asyncSendArgs.TryPop(retVar) Then + retVar.RemoteEndPoint = RemoteEndPoint() + Else + retVar = New SocketAsyncEventArgs With {.RemoteEndPoint = RemoteEndPoint()} + AddHandler retVar.Completed, AddressOf OnAsyncIOCompleted + End If + + Interlocked.Increment(_asyncActiveSends) + Return retVar + + End Function + + ''' + ''' Stores a SocketAsyncEventArg for future reuse + ''' + ''' An object + Private Sub RecycleSendArg(e As SocketAsyncEventArgs) + + Interlocked.Decrement(_asyncActiveSends) + If IsConnected Then _asyncSendArgs.Push(e) + + End Sub + + ''' + ''' Releases all created SocketAsyncEventArgs + ''' + Private Sub FlushSendArgs() + + Dim item As SocketAsyncEventArgs = Nothing + + While _asyncSendArgs.TryPop(item) > 0 + RemoveHandler item.Completed, AddressOf OnAsyncIOCompleted + item.Dispose() + End While + + item = Nothing + + End Sub + +#End Region + + +#Region " Callbacks for async operations" + + + ''' + ''' Handles async IO operations + ''' + Private Sub OnAsyncIOCompleted(sender As Object, e As SocketAsyncEventArgs) + + If e Is Nothing Then + + Call Disconnect() + + Else + + Select Case e.LastOperation + + Case SocketAsyncOperation.Connect + + If e.SocketError = SocketError.Success Then + + Logger.Log(7, String.Format("Connected to {0}", e.RemoteEndPoint.ToString), _context) + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf OnConnected)) + + Else + + Logger.Log(7, String.Format("Connection to {0} failed [ {1} ]", e.RemoteEndPoint.ToString, [Enum].GetName(GetType(SocketError), e.SocketError).ToString()), _context) + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf OnConnectionFailed)) + + End If + + Case SocketAsyncOperation.Disconnect + + Logger.Log(7, String.Format("Disconnected from {0}", e.RemoteEndPoint.ToString), _context) + ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf OnDisconnected)) + + Case SocketAsyncOperation.Receive + + If e.SocketError = SocketError.Success Then + + If e.BytesTransferred > 0 Then + + _lastInboundTimeStamp = DateTime.Now + If Not disposedValue Then Call ReceiveSocketData(e) + + Else + + If Not _connectionStatus.HasFlags({AsyncSocketStatus.Disconnecting}) Then + Logger.Log(7, String.Format("{0} remotely closed connection", e.RemoteEndPoint.ToString), _context) + + ' Gracefully closes resources + Disconnect() + End If + + End If + Else + + If (e.SocketError <> SocketError.NotConnected AndAlso + e.SocketError <> SocketError.OperationAborted) Then + + Logger.Log(0, String.Format("{0} socket error : {1}", e.RemoteEndPoint.ToString, [Enum].GetName(GetType(SocketError), e.SocketError).ToString()), _context) + + ' Gracefully closes resources + Disconnect() + + End If + + End If + + Case SocketAsyncOperation.Send + + If e.SocketError <> SocketError.Success OrElse e.BytesTransferred = 0 Then + Logger.Log(0, String.Format("Failed to send to {0} : {1}", e.RemoteEndPoint.ToString, [Enum].GetName(GetType(SocketError), e.SocketError).ToString()), _context) + Call RecycleSendArg(e) + Call Disconnect() + Return + End If + + _lastOutboundTimeStamp = DateTime.Now + Call RecycleSendArg(e) + + End Select + + End If + + End Sub + +#End Region + +#Region " Helpers" + + Private Function ConvertToIPEndPoint(ByRef ep As EndPoint) As IPEndPoint + + Dim ipAddress As IPAddress = IPAddress.Parse(ep.ToString.Split(":")(0)) + Dim port As Integer = Convert.ToInt32(ep.ToString.Split(":")(1)) + Return New IPEndPoint(ipAddress, port) + + End Function + + ''' + ''' Sets keep-alive intervals for socket + ''' + ''' The socket to manage + ''' First keep-alive in ms + ''' Retry keep-alive in ms + ''' + Private Function SetKeepAlive(ByRef tcpSocket As Socket, ByVal keepAliveTime As UInteger, ByVal keepAliveInterval As UInteger) As Boolean + + ' Pack three params into 12-element byte array; not sure about endian issues on non-Intel + Dim SIO_KEEPALIVE_VALS(11) As Byte + Dim keepAliveEnable As UInteger = 1 + If (keepAliveTime = 0 Or keepAliveInterval = 0) Then keepAliveEnable = 0 + ' Bytes 00-03 are 'enable' where '1' is true, '0' is false + ' Bytes 04-07 are 'time' in milliseconds + ' Bytes 08-12 are 'interval' in milliseconds + Array.Copy(BitConverter.GetBytes(keepAliveEnable), 0, SIO_KEEPALIVE_VALS, 0, 4) + Array.Copy(BitConverter.GetBytes(keepAliveTime), 0, SIO_KEEPALIVE_VALS, 4, 4) + Array.Copy(BitConverter.GetBytes(keepAliveInterval), 0, SIO_KEEPALIVE_VALS, 8, 4) + + Try + Dim result() As Byte = BitConverter.GetBytes(CUInt(0)) ' Result needs 4-element byte array? + tcpSocket.IOControl(IOControlCode.KeepAliveValues, SIO_KEEPALIVE_VALS, result) + Catch e As Exception + Return False + End Try + Return True + + End Function + + +#End Region + +#Region "IDisposable Support" + + Private disposedValue As Boolean ' To detect redundant calls + + ' IDisposable + Protected Overridable Sub Dispose(disposing As Boolean) + If Not disposedValue Then + + If disposing Then + + If IsConnected Then Disconnect() + + End If + + ' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below. + ' TODO: set large fields to null. + End If + disposedValue = True + End Sub + + ' TODO: override Finalize() only if Dispose(disposing As Boolean) above has code to free unmanaged resources. + 'Protected Overrides Sub Finalize() + ' ' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above. + ' Dispose(False) + ' MyBase.Finalize() + 'End Sub + + ' This code added by Visual Basic to correctly implement the disposable pattern. + Public Sub Dispose() Implements IDisposable.Dispose + ' Do not change this code. Put cleanup code in Dispose(disposing As Boolean) above. + Dispose(True) + ' TODO: uncomment the following line if Finalize() is overridden above. + ' GC.SuppressFinalize(Me) + End Sub + +#End Region + + End Class + +End Namespace