1 #Region "Microsoft.VisualBasic::0b316170a7cdd4d2b3a19cc0985b9022, Microsoft.VisualBasic.Core\ApplicationServices\Tools\Network\Tcp\Persistent\MessagePushServices\MessagePushServer.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Class MessagePushServer
35     
36     '         Properties: LocalPort, ProtocolHandler, Responsehandler, SSLMode, UidMappings
37     '                     UidMappingsBack
38     
39     '         Constructor: (+1 OverloadsSub New
40     
41     '         Function: __broadcastMessage, __getMyIPAddress, __isGetSocketPortal, __isUserOnlineQuery, __Logon
42     '                   __nonUidMappings, __requestHandlerInterface, (+2 Overloads) __sendMessage, __usrInvokeSend, GetEnumerator
43     '                   IEnumerable_GetEnumerator, Run
44     
45     '         Sub: __socketCleanup, AcceptClient, DisconnectUser, Dispose, Install
46     '              RemoveFreeConnections, Run, SendMessage
47     
48     
49     ' /********************************************************************************/
50
51 #End Region
52
53 Imports System.Reflection
54 Imports System.Threading
55 Imports Microsoft.VisualBasic.ComponentModel
56 Imports Microsoft.VisualBasic.Linq.Extensions
57 Imports Microsoft.VisualBasic.Net.Abstract
58 Imports Microsoft.VisualBasic.Net.Http
59 Imports Microsoft.VisualBasic.Net.Persistent.Application.Protocols
60 Imports Microsoft.VisualBasic.Net.Persistent.Socket
61 Imports Microsoft.VisualBasic.Net.Protocols
62 Imports Microsoft.VisualBasic.Net.Protocols.Reflection
63
64 Namespace Net.Persistent.Application
65
66     ''' <summary>
67     ''' 长连接模式的消息推送服务器
68     ''' </summary>
69     <Protocol(GetType(ServicesProtocol.Protocols))>
70     Public Class MessagePushServer : Inherits ServicesSocket
71         Implements IEnumerable(Of KeyValuePair(Of Long, WorkSocket))
72         Implements ITaskDriver, IDataRequestHandler
73
74         Public ReadOnly Property ProtocolHandler As ProtocolHandler
75
76         Dim _socketList As New Dictionary(Of Long, WorkSocket)
77         ''' <summary>
78         ''' 客户端对这个服务器的端口号是自动配置的,只需要向客户端返回<see cref="_LocalPort"/>端口就可以了
79         ''' </summary>
80         Dim _workSocket As TcpSynchronizationServicesSocket
81         Dim _offlineMessageSendHandler As OffLineMessageSendHandler
82         ''' <summary>
83         ''' 使用证书来加密发出去的消息
84         ''' </summary>
85         Dim _sslLayer As SSL.ISSLServices
86
87         Public ReadOnly Property SSLMode As Boolean
88
89         Public Sub Install(ssl As SSL.ISSLServices)
90             _sslLayer = ssl
91             _SSLMode = Not ssl Is Nothing
92         End Sub
93
94         ''' <summary>
95         ''' 从这个端口号进行登录(协同长连接的socket正常工作的socket的端口号,可以看作为UserAPI)
96         ''' </summary>
97         ''' <returns></returns>
98         Public Overrides ReadOnly Property LocalPort As Integer
99             Get
100                 Return Me._workSocket.LocalPort
101             End Get
102         End Property
103
104         Dim _responsehandler As DataRequestHandler
105
106         Friend Property Responsehandler As DataRequestHandler Implements IDataRequestHandler.Responsehandler
107             Get
108                 Return _responsehandler
109             End Get
110             Set(value As DataRequestHandler)
111                 _responsehandler = value
112                 Me._workSocket.Responsehandler = AddressOf __requestHandlerInterface
113             End Set
114         End Property
115
116         ''' <summary>
117         ''' 只要是为ssl服务设置的
118         ''' </summary>
119         ''' <param name="remote"></param>
120         ''' <returns></returns>
121         Private Function __requestHandlerInterface(CA As Long,
122                                                    requestData As RequestStream,
123                                                    remote As System.Net.IPEndPoint) As RequestStream
124             requestData = _responsehandler(CA, requestData, remote)
125             Return requestData
126         End Function
127
128         ''' <summary>
129         ''' 
130         ''' </summary>
131         ''' <param name="LocalPort"></param>
132         ''' <param name="OffLineMessageSendHandler">Public Delegate Sub <see cref="OffLineMessageSendHandler"/>(FromUSER_ID As <see cref="Long"/>, USER_ID As <see cref="Long"/>, Message As <see cref="RequestStream"/>)</param>
133         ''' <param name="exHandler"></param>
134         Sub New(Optional LocalPort As Integer = 11000,
135                 Optional OffLineMessageSendHandler As OffLineMessageSendHandler = Nothing,
136                 Optional exHandler As Abstract.ExceptionHandler = Nothing)
137
138             Call MyBase.New(GetFirstAvailablePort(5000), exHandler)
139
140             Me._ProtocolHandler = New ProtocolHandler(Me)
141             Me.AcceptCallbackHandleInvoke = AddressOf AcceptClient
142             Me._workSocket = New TcpSynchronizationServicesSocket(AddressOf _ProtocolHandler.HandleRequest, LocalPort, Me.__exceptionHandle)
143             Me._offlineMessageSendHandler = If(OffLineMessageSendHandler Is Nothing,
144                 Sub([from], USER_ID, MESSAGE) Call Console.WriteLine($" >>> [DEBUG {Now.ToString},  {from} => {USER_ID}]  {MESSAGE}"),
145                 OffLineMessageSendHandler)
146         End Sub
147
148         Public Overrides Sub Run(localEndPoint As System.Net.IPEndPoint)
149             Call New Thread(AddressOf Me._workSocket.Run).Start()
150             Call Thread.Sleep(1000)
151             Call $"please logon server {Me.GetType.Name} at api_port={Me._workSocket.LocalPort}".__DEBUG_ECHO
152             Call MyBase.Run(localEndPoint)
153         End Sub
154
155         Public Overrides Function Run() As Integer Implements ITaskDriver.Run
156             Return MyBase.Run()
157         End Function
158
159         ''' <summary>
160         ''' Disconnect user persistent connection who have the specific <paramref name="user_id"/> from this server.
161         ''' (断开服务器与用户客户端的长连接)
162         ''' </summary>
163         ''' <param name="USER_ID">This user will be deleted from the server registry.</param>
164         ''' <param name="removeCA">是否在删除socket句柄的时候还会删除相对应的ssl证书</param>
165         Public Sub DisconnectUser(USER_ID As Long, removeCA As Boolean)
166             If Me._socketList.ContainsKey(USER_ID) Then
167                 Dim socket As WorkSocket = _socketList(USER_ID)
168                 Call _socketList.Remove(USER_ID)
169                 Call $"Clean up connection for user {USER_ID} previous connection.".__DEBUG_ECHO
170                 Call socket.Free
171             End If
172             If removeCA AndAlso SSLMode Then
173                 If _sslLayer.PrivateKeys.ContainsKey(USER_ID) Then
174                     Call _sslLayer.PrivateKeys.Remove(USER_ID)
175                 End If
176             End If
177         End Sub
178
179         Protected Overrides Sub __socketCleanup(hash As Integer)
180             Dim LQuery = (From usr In _socketList Where hash = usr.Value.GetHashCode Select usr.Key).FirstOrDefault
181             Call DisconnectUser(LQuery, True)
182         End Sub
183
184         ''' <summary>
185         ''' 
186         ''' </summary>
187         ''' <param name="From"></param>
188         ''' <param name="USER_ID"></param>
189         ''' <param name="Message"></param>
190         Public Sub SendMessage(From As Long, USER_ID As LongMessage As RequestStream)
191             Dim request = ServicesProtocol.SendMessageRequest(From, USER_ID, Message)
192             Call __sendMessage(From, USER_ID, request)
193         End Sub
194
195         ''' <summary>
196         ''' 发送出去的数据需要进行加密,假若是ssl模式的话
197         ''' </summary>
198         ''' <param name="From"></param>
199         ''' <param name="USER_ID"></param>
200         ''' <param name="Message"></param>
201         ''' <returns></returns>
202         Private Function __sendMessage(From As Long, USER_ID As LongMessage As RequestStream) As RequestStream
203 #If DEBUG Then
204             Call Console.Write($"{MethodBase.GetCurrentMethod.GetFullName}   {NameOf(USER_ID)}:{USER_ID} mappings to ")
205 #End If
206             USER_ID = _UidMappings(USER_ID)
207 #If DEBUG Then
208             Call Console.WriteLine(USER_ID) '衔接着上一个输出语句
209 #End If
210             If Me._socketList.ContainsKey(USER_ID) Then
211                 Dim Socket As WorkSocket = Me._socketList(USER_ID)
212                 Return __sendMessage(Socket, From, USER_ID, Message)
213             End If
214
215 #If DEBUG Then
216             Call $"Unable to found user '{USER_ID}' on server...".__DEBUG_ECHO
217             Call $"Current users: {String.Join("", _socketList.Keys.Select(Function(id) CStr(id)).ToArray)}".__DEBUG_ECHO
218 #End If
219             Call Me._offlineMessageSendHandler(From, USER_ID, Message)
220             Return NetResponse.RFC_TEMP_REDIRECT
221         End Function
222
223         ''' <summary>
224         ''' 将外部编号映射为内部的客户端句柄
225         ''' 假若找不到,请返回-1
226         ''' </summary>
227         ''' <returns></returns>
228         Public Property UidMappings As Func(Of LongLong) = AddressOf __nonUidMappings
229         Public Property UidMappingsBack As Func(Of LongLong) = AddressOf __nonUidMappings
230
231         Private Shared Function __nonUidMappings(USER_ID As LongAs Long
232             Return USER_ID
233         End Function
234
235         ''' <summary>
236         ''' 
237         ''' </summary>
238         ''' <param name="socket"></param>
239         ''' <param name="From">这个是这一条消息的源头,可能需要进行映射</param>
240         ''' <param name="USER_ID"></param>
241         ''' <param name="Message"></param>
242         ''' <returns></returns>
243         Private Function __sendMessage(socket As WorkSocket,
244                                        From As Long,
245                                        USER_ID As Long,
246                                        Message As RequestStream) As RequestStream
247
248             From = Me._UidMappingsBack(From)
249
250             If socket Is Nothing OrElse socket.workSocket Is Nothing Then
251                 Call _socketList.Remove(USER_ID)
252                 Call Me._offlineMessageSendHandler(From, USER_ID, Message)
253                 Return NetResponse.RFC_TEMP_REDIRECT
254             End If
255
256 #If DEBUG Then
257             Call Console.WriteLine($"*Call {NameOf(__sendMessage)}  ===> {Message}")
258 #End If
259             If SSLMode Then
260                 Dim CA As SSL.Certificate = _sslLayer.PrivateKeys(USER_ID)
261                 Dim post As New SendMessagePost(Message.ChunkBuffer)
262                 post.Message = CA.Encrypt(post.Message)
263                 post.FROM = From
264                 Message = New RequestStream(ServicesProtocol.ProtocolEntry,
265                                             ServicesProtocol.Protocols.SendMessage,
266                                             post.Serialize)
267 #If DEBUG Then
268                 Call $"Request encrypts from {CA.uid} job done!".__DEBUG_ECHO
269 #End If
270             End If
271
272             Call socket.SendMessage(Message) '原封不动的进行数据转发
273             Return NetResponse.RFC_OK
274         End Function
275
276         ''' <summary>
277         ''' 用户客户端请求发送消息至指定编号的用户的终端之上
278         ''' </summary>
279         ''' <param name="CA"></param>
280         ''' <param name="request"></param>
281         ''' <param name="remote"></param>
282         ''' <returns></returns>
283         <Protocol(ServicesProtocol.Protocols.SendMessage)>
284         Private Function __usrInvokeSend(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
285             Dim [From] As Long, USER_ID As Long
286 #If DEBUG Then
287             Call $"{NameOf(From)}:{From} invoke send to {NameOf(USER_ID)}:{USER_ID}".__DEBUG_ECHO
288 #End If
289             If ServicesProtocol.GetSendMessage(request, From, USER_ID) Then
290                 Return Me.__sendMessage(From, USER_ID, request)
291             Else
292                 Return NetResponse.RFC_TOKEN_INVALID
293             End If
294         End Function
295
296         <Protocol(ServicesProtocol.Protocols.Logon)>
297         Private Function __Logon(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
298             Dim USER_ID As Long, remoteEp As String = ""
299
300             If Not ServicesProtocol.GetLogOnUSER(request.GetUTF8String, USER_ID, remoteEp) Then
301                 Return NetResponse.RFC_TOKEN_INVALID
302             End If
303
304             Dim hash As Integer = CInt(Val(remoteEp))
305
306             If Not Me._Connections.ContainsKey(hash) Then
307                 Call Console.WriteLine($"No connection could be made! {hash} for socket hash is not exists in the hash table!")
308                 Return NetResponse.RFC_CONFLICT
309             End If
310
311             Dim SocketClient As WorkSocket = Nothing
312             Call Me._Connections.TryGetValue(hash, SocketClient)
313
314             If SocketClient Is Nothing Then
315                 Call Console.WriteLine("No connection could be made!")
316                 Return NetResponse.RFC_BAD_GATEWAY
317             Else
318                 Call Console.WriteLine(" >> " & SocketClient.workSocket.RemoteEndPoint.ToString)
319             End If
320
321             Call DisconnectUser(USER_ID, False)
322             Call _socketList.Add(USER_ID, SocketClient)
323
324             Return NetResponse.RFC_OK
325         End Function
326
327         <Protocol(ServicesProtocol.Protocols.Broadcast)>
328         Private Function __broadcastMessage(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
329             For Each cnn In Me.Connections
330                 Call cnn.SendMessage(request)
331             Next
332             Return NetResponse.RFC_OK
333         End Function
334
335         <Protocol(ServicesProtocol.Protocols.GetMyIPAddress)>
336         Private Function __getMyIPAddress(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
337             Return New RequestStream(0, HTTP_RFC.RFC_OK, remote.ToString.Split(":"c)(Scan0))
338         End Function
339
340         <Protocol(ServicesProtocol.Protocols.ConfigConnection)>
341         Private Function __isGetSocketPortal(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
342             Return New RequestStream(0, HTTP_RFC.RFC_OK, CStr(_LocalPort))
343         End Function
344
345         <Protocol(ServicesProtocol.Protocols.IsUserOnline)>
346         Private Function __isUserOnlineQuery(CA As Long, request As RequestStream, remote As System.Net.IPEndPoint) As RequestStream
347             Dim USER_ID As Long = Scripting.CTypeDynamic(Of Long)(request.GetUTF8String)
348             Dim result As String = CStr(Me._socketList.ContainsKey(USER_ID))
349             Return New RequestStream(0, HTTP_RFC.RFC_OK, result)
350         End Function
351
352         Dim _freeCnnInfo As New List(Of String)
353
354         ''' <summary>
355         ''' 哈希值不存在于现有的登录用户列表之中就是空闲连接
356         ''' </summary>
357         Public Sub RemoveFreeConnections()
358             Dim LQuery = (From Guid As String In _freeCnnInfo.AsParallel  '上一次刷新的时候的空闲连接
359                           Let LowCnn = (From cnn In Me.Connections.AsParallel
360                                         Where Guid.Equals(CStr(cnn.GetHashCode))
361                                         Select cnn).FirstOrDefault
362                           Where Not LowCnn Is Nothing AndAlso
363                               (From cnn In Me._socketList
364                                Where Guid.Equals(CStr(cnn.Value.GetHashCode))
365                                Select cnn).ToArray.IsNullOrEmpty  '哈希值不存在的
366                           Select LowCnn).ToArray  '对于上一次刷新的列表之中的连接而言,假若在这么长的一段时间间隔之中还是处于空闲状态,则服务器会将这些连接断开连接
367             For Each cnn In LQuery
368                 Call Me.ForceCloseHandle(cnn)
369                 Call cnn.Free
370             Next
371
372             Call $"Clean up {LQuery.Length } free connections.....".__DEBUG_ECHO
373             '获取新产生的空闲连接
374             _freeCnnInfo = (From cnn In Me._Connections.AsParallel
375                             Where (From item In Me._socketList Where item.Value.GetHashCode = cnn.GetHashCode Select 1).ToArray.IsNullOrEmpty
376                             Select Guid = CStr(cnn.GetHashCode)).AsList
377             Call $"{_freeCnnInfo.Count} free connections pending for clean up....".__DEBUG_ECHO
378
379             For Each usr In Me._socketList.ToArray
380                 Call usr.Value.SendMessage(NetResponse.RFC_OK)
381             Next
382         End Sub
383
384         ''' <summary>
385         ''' 建立一个新的连接
386         ''' </summary>
387         ''' <param name="Client"></param>
388         Private Sub AcceptClient(Client As WorkSocket)
389             'Do Nothing
390             Call $"{Client.workSocket.RemoteEndPoint.ToString} connection request accept!".__DEBUG_ECHO
391         End Sub
392
393         Public Iterator Function GetEnumerator() As IEnumerator(Of KeyValuePair(Of Long, WorkSocket)) Implements IEnumerable(Of KeyValuePair(Of Long, WorkSocket)).GetEnumerator
394             For Each entry In Me._socketList.ToArray
395                 Yield entry
396             Next
397         End Function
398
399         Private Iterator Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
400             Yield GetEnumerator()
401         End Function
402
403         Protected Overrides Sub Dispose(disposing As Boolean)
404             If disposing Then
405                 For Each cnn In Me._socketList.ToArray
406                     Call DisconnectUser(cnn.Key, True)
407                 Next
408             End If
409             Call MyBase.Dispose(disposing)
410         End Sub
411     End Class
412 End Namespace