1 #Region "Microsoft.VisualBasic::a9d3b4643cdebfd30e5c7ed4825f5ef4, Microsoft.VisualBasic.Core\ApplicationServices\Tools\Network\SSL\Protocol.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     '     Module SSLProtocols
35     
36     '         Function: (+3 Overloads) Handshaking
37     '         Interface ISSLServices
38     
39     '             Properties: CA, DeclaringModule, InstallCertificates, PrivateKeys, RaiseHandshakingEvent
40     '                         RefuseHandshake, ResponseHandler
41     
42     '             FunctionInstall
43     
44     '         Delegate Sub
45     
46     
47     '         Delegate Function
48     
49     '             Function: __sslHandshake, SSLServicesResponseHandler
50     
51     
52     
53     
54     
55     ' /********************************************************************************/
56
57 #End Region
58
59 Imports System.Reflection
60 Imports Microsoft.VisualBasic.Net.Http
61 Imports Microsoft.VisualBasic.Net.Protocols
62 Imports Microsoft.VisualBasic.Win32
63
64 Namespace Net.SSL
65
66     Public Module SSLProtocols
67
68         ''' <summary>
69         ''' 客户端与服务器之间初始化加密连接
70         ''' </summary>
71         ''' <param name="CA">客户端的证书,这个是服务器来进行客户端程序的完整性验证的</param>
72         ''' <returns></returns>
73         Public Function Handshaking(CA As SSL.Certificate, services As System.Net.IPEndPoint) As SSL.Certificate
74             Dim request As RequestStream =
75                 New RequestStream(RequestStream.SYS_PROTOCOL,
76                                   RequestStream.Protocols.SSLHandshake,
77                                   New Byte() {}) With {
78                     .uid = CA.uid
79             }
80             request = New Net.AsynInvoke(services).SendMessage(request, CA, isPublicToken:=True) '这个函数会把用户的账号和当前的客户端的数字证书发送给服务器
81 #If DEBUG Then
82             Call $"[{MethodBase.GetCurrentMethod.GetFullName}] Handshaking {NameOf(CA)} hash:={CA.uid}".__DEBUG_ECHO
83 #End If
84             '服务器验证数字证书通过之后就会返回动态的客户端的私有密匙,一般是对随机数做MD5得到私有密匙
85             Dim PrivateKey As New SSL.Certificate(request)
86 #If DEBUG Then
87             Call $"[{MethodBase.GetCurrentMethod.GetFullName}] Handshaking {NameOf(PrivateKey)} hash:={PrivateKey.uid}".__DEBUG_ECHO
88 #End If
89             Return PrivateKey
90         End Function
91
92         Public Function Handshaking(PublicToken As SSL.Certificate, uid As String, services As System.Net.IPEndPoint) As SSL.Certificate
93             Dim CA = SSL.Certificate.CopyFrom(PublicToken, uid)
94 #If DEBUG Then
95             Call $"[{MethodBase.GetCurrentMethod.GetFullName}] Handshaking {NameOf(CA)} hash:={CA.uid}".__DEBUG_ECHO
96 #End If
97             Dim privateKey As SSL.Certificate = Handshaking(CA, services)
98 #If DEBUG Then
99             Call $"[{MethodBase.GetCurrentMethod.GetFullName}] Handshaking {NameOf(privateKey)} hash:={privateKey.uid}".__DEBUG_ECHO
100 #End If
101             Return privateKey
102         End Function
103
104         Public Function Handshaking(CA As SSL.Certificate, services As System.Net.IPEndPoint, Install As InstallCertificates) As SSL.Certificate
105             Dim request As RequestStream =
106                 New RequestStream(RequestStream.SYS_PROTOCOL,
107                                   RequestStream.Protocols.SSLHandshake,
108                                   New Byte() {}) With {
109                     .uid = CA.uid
110             }
111             request = New Net.AsynInvoke(services).SendMessage(request, CA, isPublicToken:=True) '这个函数会把用户的账号和当前的客户端的数字证书发送给服务器
112 #If DEBUG Then
113             Call $"[{MethodBase.GetCurrentMethod.GetFullName}] Handshaking {NameOf(CA)} hash:={CA.uid}".__DEBUG_ECHO
114 #End If
115             '服务器验证数字证书通过之后就会返回动态的客户端的私有密匙,一般是对随机数做MD5得到私有密匙
116             Dim PrivateKey As SSL.Certificate = Install(request.GetUTF8String, CA.uid)
117 #If DEBUG Then
118             Call $"[{MethodBase.GetCurrentMethod.GetFullName}] Handshaking {NameOf(PrivateKey)} hash:={PrivateKey.uid}".__DEBUG_ECHO
119 #End If
120             Return PrivateKey
121         End Function
122
123         ''' <summary>
124         ''' 抽象SSL服务器
125         ''' </summary>
126         Public Interface ISSLServices
127
128             ''' <summary>
129             ''' 告诉SSL层如何安装数字证书
130             ''' </summary>
131             ''' <returns></returns>
132             Property InstallCertificates As InstallCertificates
133             ''' <summary>
134             ''' 有新的客户端请求进行连接
135             ''' </summary>
136             ''' <returns></returns>
137             Property RaiseHandshakingEvent As HandshakingEvent
138             ''' <summary>
139             ''' 对于某些应用出于安全性的考虑,会将这里设置为False,则服务器就会全部拒绝后面的所有的握手请求,只接受来自于从外部导入的用户证书的数据请求
140             ''' </summary>
141             ''' <returns></returns>
142             Property RefuseHandshake As Boolean
143
144             ''' <summary>
145             ''' 公共密匙
146             ''' </summary>
147             ''' <returns></returns>
148             ReadOnly Property CA As SSL.Certificate
149             ''' <summary>
150             ''' 客户端的私有密匙
151             ''' </summary>
152             ''' <returns></returns>
153             ReadOnly Property PrivateKeys As Dictionary(Of Long, SSL.Certificate)
154             ''' <summary>
155             ''' 处理私有密匙的数据请求
156             ''' </summary>
157             ''' <returns></returns>
158             ReadOnly Property ResponseHandler As Net.Abstract.DataRequestHandler
159             ReadOnly Property DeclaringModule As Object
160
161             ''' <summary>
162             ''' 
163             ''' </summary>
164             ''' <param name="CA"></param>
165             ''' <param name="[overrides]">当证书的哈希值有冲突的时候,新安装的证书<paramref name="ca"/>可不可以将旧的证书覆盖掉</param>
166             Function Install(CA As Certificate, [overrides] As BooleanOptional trace As String = ""As Boolean
167
168         End Interface
169
170         Public Delegate Sub HandshakingEvent(uid As Long, CA As SSL.Certificate, remoteDev As System.Net.IPEndPoint)
171         Public Delegate Function InstallCertificates(privateKey As String, uid As LongAs Certificate
172
173         ''' <summary>
174         ''' 
175         ''' </summary>
176         ''' <param name="ssl"></param>
177         ''' <param name="CA">解密使用的证书凭据,这个用来鉴别客户端身份是否被伪造</param>
178         ''' <param name="request"></param>
179         ''' <param name="remoteDev"></param>
180         ''' <param name="InstallCertificates"></param>
181         ''' <returns></returns>
182         Public Function SSLServicesResponseHandler(ssl As ISSLServices, CA As Long,
183                                                    request As RequestStream,
184                                                    remoteDev As System.Net.IPEndPoint,
185                                                    InstallCertificates As InstallCertificates) As RequestStream
186             Dim uid As Long
187
188             If request.IsSSL_PublicToken Then
189                 uid = request.uid
190                 request = ssl.CA.Decrypt(request)
191             End If
192
193             If request.IsSSLHandshaking Then  '客户端与服务器之间进行连接的初始化,服务器会在这里为客户端动态的生成一个密匙
194                 request = __sslHandshake(uid, ssl, request, remoteDev, InstallCertificates)
195                 Return request
196             ElseIf request.IsSSLProtocol Then
197                 uid = request.uid
198
199                 If Not ssl.PrivateKeys.ContainsKey(uid) Then  ' 不存在的数字证书
200                     ' 记录进系统日志
201                     If WindowsServices.Initialized Then
202                         Call ServicesLogs.WriteEntry({$"Remote socket {remoteDev.ToString} try send request with an not authorised certificates, and ssl server refused this request!",
203                                                      $"{NameOf(CA)} (not_authorised)   {CA}",
204                                                      $"{NameOf(remoteDev)}:  {remoteDev.ToString}"},
205                                                      $"{ssl.DeclaringModule.GetType.FullName} [{Scripting.ToString(ssl.DeclaringModule)}]  ==> {MethodBase.GetCurrentMethod}",
206                                                      EventLogEntryType.Warning)
207                     End If
208
209                     Return New RequestStream(RequestStream.SYS_PROTOCOL,
210                                              RequestStream.Protocols.InvalidCertificates,
211                                              NameOf(RequestStream.Protocols.InvalidCertificates))
212                 End If
213
214                 Dim PrivateCertificate As SSL.Certificate = ssl.PrivateKeys(uid)
215                 request = PrivateCertificate.Decrypt(request)   '使用用户的私有密匙进行加密
216                 request = ssl.ResponseHandler(CA, request, remoteDev)  ' CA应该是用户客户端的数字证书编号
217                 request = PrivateCertificate.Encrypt(request)
218                 Return request
219             End If
220
221             Return NetResponse.RFC_NO_CERT
222         End Function
223
224         ''' <summary>
225         ''' 客户端与服务器之间进行连接的初始化,服务器会在这里为客户端动态的生成一个密匙
226         ''' </summary>
227         ''' <returns></returns>
228         Private Function __sslHandshake(uid As Long, ssl As ISSLServices,
229                                         request As RequestStream,
230                                         remoteDev As System.Net.IPEndPoint,
231                                         InstallCertificates As InstallCertificates) As RequestStream
232             If ssl.RefuseHandshake Then
233                 Return New RequestStream(RequestStream.SYS_PROTOCOL,
234                                          RequestStream.Protocols.InvalidCertificates,
235                                          "Services Refused!")
236             End If
237
238             Dim key As String = Guid.NewGuid.ToString
239             key = SecurityString.MD5Hash.GetMd5Hash(key)
240
241             If uid <> request.uid Then
242                 Return New RequestStream(RequestStream.SYS_PROTOCOL,
243                                          RequestStream.Protocols.InvalidCertificates,
244                                          NameOf(RequestStream.Protocols.InvalidCertificates))
245             Else
246                 request = New RequestStream(RequestStream.SYS_PROTOCOL,
247                                             RequestStream.Protocols.SSLHandshake, key) With {
248                                             .uid = uid
249                 }
250             End If
251
252             If ssl.PrivateKeys.ContainsKey(uid) Then  ' 哈希函数设计不正确,有重复的哈希值,则当前的握手用户不能够使用这个哈希值,需要重新握手
253                 Call $"{NameOf(SSLServicesResponseHandler)} ==> {uid} was duplicated!".__DEBUG_ECHO
254                 Return New RequestStream(RequestStream.SYS_PROTOCOL, RequestStream.Protocols.InvalidCertificates, "Duplicated hash value!")
255             End If
256
257 #If DEBUG Then
258             Call $"[{MethodBase.GetCurrentMethod.GetFullName}] Handshaking hash:={uid}".__DEBUG_ECHO
259 #End If
260
261             Dim PrivateKey As SSL.Certificate = InstallCertificates(key, uid)
262             Call ssl.PrivateKeys.Add(uid, PrivateKey)
263             Call ssl.RaiseHandshakingEvent()(uid, PrivateKey, remoteDev)
264
265             request = Net.SSL.Certificate.CopyFrom(ssl.CA, uid).Encrypt(request)
266
267             Return request
268         End Function
269
270     End Module
271 End Namespace