Imported Claus Isager's CICRadarR

CICRadarR/RADIUSServer.vb

@@ -0,0 +1,156 @@
+Imports System.Net
+Imports CICRadarR.Conversion
+
+Public Class RADIUSServer
+
+    Private mSocket As UDPServer
+    Private mSecrets As NASAuthList
+    Private mLastAuthenticator() As Byte = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}
+
+    Public Delegate Sub RADIUSHandler(ByVal packet As RADIUSPacket)
+
+    Private HandlePacket As RADIUSHandler
+
+    Public Sub New(ByVal portNumber As Integer, ByVal onRADIUSPacket As RADIUSHandler, ByRef secrets As NASAuthList)
+        mSocket = New UDPServer(portNumber, AddressOf SocketData)
+        HandlePacket = onRADIUSPacket
+        mSecrets = secrets
+    End Sub
+
+    Public Sub New(ByVal ipAddress As String, ByVal portNumber As Integer, ByVal onRADIUSPacket As RADIUSHandler, ByRef secrets As NASAuthList)
+        mSocket = New UDPServer(ipAddress, portNumber, AddressOf SocketData)
+        HandlePacket = onRADIUSPacket
+        mSecrets = secrets
+    End Sub
+
+    Friend ReadOnly Property NASList() As NASAuthList
+        Get
+            Return mSecrets
+        End Get
+    End Property
+
+    Public Sub SendAsRequest(ByVal packet As RADIUSPacket)
+        If packet Is Nothing Then Exit Sub
+        If Not packet.IsValid Then Exit Sub
+        Dim data() As Byte = packet.Bytes
+        Dim hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create
+        Dim hash() As Byte = {}
+        Dim secret As String = mSecrets.GetSharedSecret(packet.EndPoint.Address.ToString)
+        Array.Resize(hash, data.Length + secret.Length)
+        data.CopyTo(hash, 0)
+        ConvertToBytes(secret).CopyTo(hash, data.Length)
+        hash = hasher.ComputeHash(hash)
+        hash.CopyTo(data, 4)
+        hash.CopyTo(mLastAuthenticator, 0)
+        mSocket.Send(data, packet.EndPoint)
+    End Sub
+
+    Public Sub SendAsResponse(ByVal packet As RADIUSPacket, ByVal requestAuth() As Byte)
+        Try
+            If packet Is Nothing Then
+                Exit Sub
+            End If
+
+            If Not packet.IsValid Then
+                Exit Sub
+            End If
+
+            If requestAuth Is Nothing Then
+                Exit Sub
+            End If
+
+            If requestAuth.Length <> 16 Then
+                Exit Sub
+            End If
+
+            Dim data() As Byte = packet.Bytes
+            Dim hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create
+            Dim hash() As Byte = {}
+            Dim secret As String = mSecrets.GetSharedSecret(packet.EndPoint.Address.ToString)
+            Array.Resize(hash, data.Length + secret.Length)
+            data.CopyTo(hash, 0)
+            ConvertToBytes(secret).CopyTo(hash, data.Length)
+            Array.Copy(requestAuth, 0, hash, 4, 16)
+            hash = hasher.ComputeHash(hash)
+            hash.CopyTo(data, 4)
+            mSocket.Send(data, packet.EndPoint)
+
+        Catch ex As Exception
+            Console.WriteLine(ex.Message)
+        End Try
+
+    End Sub
+
+    Private Sub SocketData(ByRef data() As Byte, ByRef ep As IPEndPoint)
+        'Verify validity ...
+        If data.Length < 20 Then
+            Exit Sub
+        End If
+
+        Dim len As Integer = data(2) * 256 + data(3)
+        If data.Length <> len Then
+            Exit Sub
+        End If
+
+        Dim code As RadiusPacketCode = data(0)
+        Dim auth As Boolean
+        If code = RadiusPacketCode.AccessRequest Or code = RadiusPacketCode.AccountingRequest Then
+            auth = AuthenticateRequest(data, mSecrets.GetSharedSecret(ep.Address.ToString))
+        Else
+            auth = AuthenticateResponse(data, mSecrets.GetSharedSecret(ep.Address.ToString))
+        End If
+        If Not auth Then
+            Exit Sub
+        End If
+
+
+        Dim packet As New RADIUSPacket(data, ep, Me)
+        HandlePacket(packet)
+    End Sub
+
+    Private Function AuthenticateRequest(ByRef dataBytes() As Byte, ByVal secret As String) As Boolean
+        If dataBytes Is Nothing Then Return False
+        If dataBytes(0) = RadiusPacketCode.AccessRequest Then Return True
+        If secret Is Nothing Then Return False
+        Dim res As Boolean = True
+        Dim i As Integer
+        Dim hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create
+        Dim expectedHash() As Byte = {}
+
+        Array.Resize(Of Byte)(expectedHash, dataBytes.Length + secret.Length)
+        dataBytes.CopyTo(expectedHash, 0)
+        ConvertToBytes(secret).CopyTo(expectedHash, dataBytes.Length)
+
+        For i = 4 To 19 : expectedHash(i) = 0 : Next ' Setting authenticator to zero...
+
+        expectedHash = hasher.ComputeHash(expectedHash)
+
+        ' Compare ...
+        i = 4 : Do While res And i <= 19 : If dataBytes(i) <> expectedHash(i - 4) Then : res = False : End If : i += 1 : Loop
+
+        Return res
+    End Function
+
+    Private Function AuthenticateResponse(ByRef dataBytes() As Byte, ByVal secret As String) As Boolean
+        If secret Is Nothing Then Return False
+        If secret = "" Then Return False
+        Dim res As Boolean = True
+        Dim i As Integer
+        Dim hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create
+        Dim expectedHash() As Byte = {}
+
+        Array.Resize(Of Byte)(expectedHash, dataBytes.Length + secret.Length)
+        dataBytes.CopyTo(expectedHash, 0)
+        ConvertToBytes(secret).CopyTo(expectedHash, dataBytes.Length)
+
+        For i = 4 To 19 : expectedHash(i) = mLastAuthenticator(i - 4) : Next ' Setting authenticator to zero...
+
+        expectedHash = hasher.ComputeHash(expectedHash)
+
+        ' Compare ...
+        i = 4 : Do While res And i <= 19 : If dataBytes(i) <> expectedHash(i - 4) Then : res = False : End If : i += 1 : Loop
+
+        Return res
+    End Function
+
+End Class