Use the Packet methods to send RADIUS replies.

This commit is contained in:
Jakob A. Dam 2015-03-27 14:14:41 +01:00 committed by Jakob Aarøe Dam
parent d7d04258e1
commit 94c9dc0275
2 changed files with 64 additions and 112 deletions

View file

@ -50,11 +50,10 @@ Public Class CICRadarR
UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt" UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt"
Log.WriteLog("---------------------------------------------------------------------------------------------------") Log.WriteLog("---------------------------------------------------------------------------------------------------")
Log.WriteLog(Now & ":" & "Starting Service") ServerLog("Starting Service")
ServerLog("Loading Configuration...")
Log.WriteLog(Now & ":" & "Loading Configuration...")
Call loadConfiguration() Call loadConfiguration()
Log.WriteLog(Now & ":" & "Starting Radius listner ports...") ServerLog("Starting Radius listner ports...")
Call StartUpServer() Call StartUpServer()
End Sub End Sub
@ -62,23 +61,21 @@ Public Class CICRadarR
Log.filePath = ApplicationPath() & "\log.txt" Log.filePath = ApplicationPath() & "\log.txt"
UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt" UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt"
Log.WriteLog("---------------------------------------------------------------------------------------------------") ServerLog("---------------------------------------------------------------------------------------------------")
Log.WriteLog(Now & ":" & "Starting Service") ServerLog("Starting Service")
ServerLog("Loading Configuration...")
Log.WriteLog(Now & ":" & "Loading Configuration...")
Call loadConfiguration() Call loadConfiguration()
Log.WriteLog(Now & ":" & "Starting Radius listner ports...") ServerLog("Starting Radius listner ports...")
Call StartUpServer() Call StartUpServer()
End Sub End Sub
Protected Overrides Sub OnStop() Protected Overrides Sub OnStop()
Log.WriteLog(Now & ":" & "Stopping Radius listner ports...") ServerLog("Stopping Radius listner ports...")
End Sub End Sub
Public Sub OnStopTest() Public Sub OnStopTest()
Log.WriteLog(Now & ":" & "Stopping Radius listner ports...") ServerLog("Stopping Radius listner ports...")
End Sub End Sub
Public Sub StartUpServer() Public Sub StartUpServer()
@ -89,32 +86,27 @@ Public Class CICRadarR
' Populate from DB, I suppose ... ' Populate from DB, I suppose ...
For Each cl As DictionaryEntry In clientHash For Each cl As DictionaryEntry In clientHash
Log.WriteLog(Now & ":" & "Adding Shared Secret to Radius Server") ServerLog("Adding Shared Secret to Radius Server")
secrets.AddSharedSecret(cl.Key, cl.Value) secrets.AddSharedSecret(cl.Key, cl.Value)
Next Next
' Then, we just create a RADIUS server ... ' Then, we just create a RADIUS server ...
Try Try
Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1812...") ServerLog("Starting Radius Server on Port 1812...")
radius1812 = New RADIUSServer(1812, AddressOf ProcessPacket1812, secrets) radius1812 = New RADIUSServer(1812, AddressOf ProcessPacket1812, secrets)
Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1812...OK") ServerLog("Starting Radius Server on Port 1812...OK")
Catch Catch
Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1812...FAILED") ServerLog("Starting Radius Server on Port 1812...FAILED")
End Try End Try
Try Try
Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1645...") ServerLog("Starting Radius Server on Port 1645...")
radius1645 = New RADIUSServer(1645, AddressOf ProcessPacket1645, secrets) radius1645 = New RADIUSServer(1645, AddressOf ProcessPacket1645, secrets)
Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1645...OK") ServerLog("Starting Radius Server on Port 1645...OK")
Catch Catch
Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1645...FAILED") ServerLog("Starting Radius Server on Port 1645...FAILED")
End Try End Try
End Sub End Sub
@ -135,25 +127,8 @@ Public Class CICRadarR
End If End If
End Sub End Sub
Private Sub RadiusAccept(ByVal server As RADIUSServer, Private Sub ServerLog(ByVal message)
ByVal packet As RADIUSPacket, Log.WriteLog(Now & ":" & message)
ByVal attributes As RADIUSAttributes
)
AccessLog("Radius Accept")
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessAccept, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End Sub
Private Sub RadiusReject(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket, ByVal attributes As RADIUSAttributes)
AccessLog("Radius Reject")
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessReject, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End Sub End Sub
Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket) Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)
@ -230,11 +205,10 @@ Public Class CICRadarR
If LaunchApp = "LAUNCH" Then If LaunchApp = "LAUNCH" Then
Dim sRadiusSessionId = packet.UserPassword Dim sRadiusSessionId = packet.UserPassword
Dim attributes As New RADIUSAttributes
Dim SessionId_Ok As Boolean = False Dim SessionId_Ok As Boolean = False
Dim sUserName As String = username.GetString.ToLower Dim sUserName As String = username.GetString.ToLower
AccessLog("RDWeb app launch: Checking token validity for user: " & sUserName) AccessLog("RDWeb app launch: Checking token validity of user: " & sUserName)
If TSGWSessionIdHash.Contains(sUserName) And TSGWSessionIdTimeStampHash.Contains(sUserName) Then If TSGWSessionIdHash.Contains(sUserName) And TSGWSessionIdTimeStampHash.Contains(sUserName) Then
Dim hashTime As DateTime = DirectCast(TSGWSessionIdTimeStampHash(sUserName), DateTime) Dim hashTime As DateTime = DirectCast(TSGWSessionIdTimeStampHash(sUserName), DateTime)
@ -253,10 +227,10 @@ Public Class CICRadarR
End If End If
If SessionId_Ok Then ' found match in hash table' Return ok If SessionId_Ok Then
RadiusAccept(server, packet, attributes) packet.AcceptAccessRequest()
Else Else
RadiusReject(server, packet, attributes) packet.RejectAccessRequest()
End If End If
ElseIf launchTSGW = "LAUNCH" Then ElseIf launchTSGW = "LAUNCH" Then
@ -267,7 +241,7 @@ Public Class CICRadarR
Dim LaunchId_Ok As Boolean = False Dim LaunchId_Ok As Boolean = False
Dim sUserName As String = username.GetString.ToLower Dim sUserName As String = username.GetString.ToLower
AccessLog("TSGateWay Connection checking token validity for user: " & sUserName) AccessLog("TSGateWay Connection checking token validity of user: " & sUserName)
Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState) Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
If existProxyState = True Then If existProxyState = True Then
@ -293,9 +267,9 @@ Public Class CICRadarR
End If End If
If LaunchId_Ok Then ' found match in hash table' Return ok If LaunchId_Ok Then ' found match in hash table' Return ok
RadiusAccept(server, packet, attributes) packet.AcceptAccessRequest(attributes)
Else Else
RadiusReject(server, packet, attributes) packet.RejectAccessRequest()
End If End If
Else Else
@ -310,7 +284,7 @@ Public Class CICRadarR
' will return Nothing. ' will return Nothing.
If username Is Nothing Then If username Is Nothing Then
' Technically, this case is against RFC, so ... drop. ' Technically, this case is against RFC, so ... drop.
AccessLog("Not a valid radius packet.. No username pressent.. Drop!") AccessLog("Not a valid radius packet.. No username present.. Drop!")
Exit Sub Exit Sub
End If End If
@ -377,13 +351,11 @@ Public Class CICRadarR
TSGWSessionIdTimeStampHash.Add(UserDomain, Now) TSGWSessionIdTimeStampHash.Add(UserDomain, Now)
End If End If
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID) Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
attributes.Add(guidAttribute) attributes.Add(guidAttribute)
RadiusAccept(server, packet, attributes) packet.AcceptAccessRequest(attributes)
Else Else
RadiusReject(server, packet, attributes) packet.RejectAccessRequest()
End If End If
If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then ' Clean first login hash table If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then ' Clean first login hash table
@ -411,7 +383,6 @@ Public Class CICRadarR
AccessLog("User " & UserDomain & " is trying to log in ...") AccessLog("User " & UserDomain & " is trying to log in ...")
Try Try
Dim dirEntry As New DirectoryEntry("LDAP://" & LDAPDomain, UserDomain, sPassword) Dim dirEntry As New DirectoryEntry("LDAP://" & LDAPDomain, UserDomain, sPassword)
@ -431,9 +402,7 @@ Public Class CICRadarR
search.PropertiesToLoad.Add(ADMailField) search.PropertiesToLoad.Add(ADMailField)
End If End If
' Time to find out if user entered the correct username and pasword ' Time to find out if user entered the correct username and pasword
If DEBUG = True Then AccessLog("Authenticating: LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain)
AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
End If
Dim result As SearchResult = search.FindOne() Dim result As SearchResult = search.FindOne()
'Get the setting form AD. Yes we uses the field primaryTelexNumber, for who the f... still users telex. (I bet half the people reading this code don't even know what a telex is!) 'Get the setting form AD. Yes we uses the field primaryTelexNumber, for who the f... still users telex. (I bet half the people reading this code don't even know what a telex is!)
'Dim code As String = DirectCast(result.Properties("primaryTelexNumber")(0), String) 'Dim code As String = DirectCast(result.Properties("primaryTelexNumber")(0), String)
@ -501,18 +470,15 @@ Public Class CICRadarR
success = False success = False
End If End If
Catch Catch
AccessLog("Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword) AccessLog("Failed to authenticate user against Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
success = False success = False
'Console.WriteLine("fu...")
'Console.WriteLine(ex.Message)
End Try End Try
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
If success Then ' Yay! Someone guess the password ... If success Then ' Yay! Someone guess the password ...
Dim sendType As String = "" Dim sendType As String = ""
AccessLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory") AccessLog("User " & UserDomain & " authenticated against Active Directory")
If EnableOTP = True Then If EnableOTP = True Then
If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then
Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific) Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
@ -559,21 +525,13 @@ Public Class CICRadarR
End If End If
Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token") Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
attributes.Add(attr)
Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid) Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid)
' Dim state As New RADIUSAttribute(RadiusAttributeType.State, "julegris") ' test
attributes.Add(attr)
attributes.Add(state) attributes.Add(state)
' Console.WriteLine("len " & packet.Authenticator.Length.ToString)
server.SendAsResponse( _ packet.SendAccessChallenge(attributes)
New RADIUSPacket(RadiusPacketCode.AccessChallenge, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
' If DEBUG = True Then
'AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
'End If
' Call SendSMS(mobile, smsCode)
' Console.WriteLine(smsCode)
Else ' One time Password not enabled, so we let the user in Else ' One time Password not enabled, so we let the user in
' add session key so user can access applications. ' add session key so user can access applications.
@ -592,23 +550,15 @@ Public Class CICRadarR
End If End If
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID) Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
attributes.Add(guidAttribute) attributes.Add(guidAttribute)
RadiusAccept(server, packet, attributes) packet.AcceptAccessRequest(attributes)
End If End If
' packetHash.Remove(username.GetString & "_" & pass.GetString) ' packetHash.Remove(username.GetString & "_" & pass.GetString)
Else ' Wrong username / password ... Else
AccessLog("User " & UserDomain & " failed to authenticate against Active Directory")
AccessLog(Now & ":" & "User " & UserDomain & " failed to authenticate agains Active Directory") packet.RejectAccessRequest()
Dim pk As New RADIUSPacket(RadiusPacketCode.AccessReject, packet.Identifier, Nothing, packet.EndPoint)
server.SendAsResponse(pk, packet.Authenticator)
' FYI ... if no additional attributes need to be added
' to the response, you can sepcify Nothing instead of
' creating an empty RADIUSAttributes object.
' packetHash.Remove(username.GetString & "_" & pass.GetString)
End If End If
End If End If
End If End If
@ -646,7 +596,7 @@ Public Class CICRadarR
End If End If
AccessLog("Processing packet for user: " & username.GetString) AccessLog("Processing packet for user: " & username.GetString)
'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then 'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then
' Exit Sub ' Exit Sub
'End If 'End If
@ -674,13 +624,11 @@ Public Class CICRadarR
End If End If
sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode) sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode)
' sid = UserDomain & "_" & packet.UserPassword
Dim attributes As New RADIUSAttributes
AccessLog("Checking for userHash " & sid) AccessLog("Checking for userHash " & sid)
If sid = state Then If sid = state Then
RadiusAccept(server, packet, attributes) packet.AcceptAccessRequest()
Else Else
RadiusReject(server, packet, attributes) packet.RejectAccessRequest()
End If End If
Else ' process the first login Else ' process the first login
@ -707,7 +655,7 @@ Public Class CICRadarR
UserDomain = NetBiosDomain & "\" & sUserName UserDomain = NetBiosDomain & "\" & sUserName
End If End If
AccessLog(Now & ":" & "User " & UserDomain & " is trying to log in ...") AccessLog("User " & UserDomain & " is trying to log in ...")
@ -736,7 +684,7 @@ Public Class CICRadarR
End If End If
' Time to find out if user entered the correct username and pasword ' Time to find out if user entered the correct username and pasword
AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword) AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
Dim result As SearchResult = search.FindOne() Dim result As SearchResult = search.FindOne()
'Get the setting form AD. Yes we uses the field primaryTelexNumber, for who the f... still users telex. (I bet half the people reading this code don't even know what a telex is!) 'Get the setting form AD. Yes we uses the field primaryTelexNumber, for who the f... still users telex. (I bet half the people reading this code don't even know what a telex is!)
'Dim code As String = DirectCast(result.Properties("primaryTelexNumber")(0), String) 'Dim code As String = DirectCast(result.Properties("primaryTelexNumber")(0), String)
@ -814,7 +762,7 @@ Public Class CICRadarR
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
If success Then ' Yay! Someone guess the password ... If success Then ' Yay! Someone guess the password ...
AccessLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory") AccessLog("User " & UserDomain & " authenticated agains Active Directory")
If EnableOTP = True Then If EnableOTP = True Then
Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token") Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
attributes.Add(attr) attributes.Add(attr)
@ -836,7 +784,7 @@ Public Class CICRadarR
End If End If
Else Else
AccessLog("One time Password not enabled, so we let the user in") AccessLog("One time Password not enabled, so we let the user in")
RadiusAccept(server, packet, attributes) packet.AcceptAccessRequest()
End If End If
' packetHash.Remove(username.GetString & "_" & pass.GetString) ' packetHash.Remove(username.GetString & "_" & pass.GetString)
Else ' Wrong username / password ... Else ' Wrong username / password ...
@ -884,12 +832,12 @@ Public Class CICRadarR
DEBUG = RConfig.GetKeyValue("CICRadarR", "Debug") DEBUG = RConfig.GetKeyValue("CICRadarR", "Debug")
NetBiosDomain = RConfig.GetKeyValue("CICRadarR", "NetBiosDomain") NetBiosDomain = RConfig.GetKeyValue("CICRadarR", "NetBiosDomain")
If NetBiosDomain.Length = 0 Then If NetBiosDomain.Length = 0 Then
Log.WriteLog(Now & ":" & "ERROR: NetBiosDomain can not be empty") ServerLog("ERROR: NetBiosDomain can not be empty")
ConfOk = False ConfOk = False
End If End If
LDAPDomain = RConfig.GetKeyValue("CICRadarR", "LDAPDomain") LDAPDomain = RConfig.GetKeyValue("CICRadarR", "LDAPDomain")
If LDAPDomain.Length = 0 Then If LDAPDomain.Length = 0 Then
Log.WriteLog(Now & ":" & "ERROR: LDAPDomain can not be empty") ServerLog("ERROR: LDAPDomain can not be empty")
ConfOk = False ConfOk = False
End If End If
@ -907,7 +855,7 @@ Public Class CICRadarR
ADField = RConfig.GetKeyValue("CICRadarR", "ADField") ADField = RConfig.GetKeyValue("CICRadarR", "ADField")
If ADField.Length = 0 Then If ADField.Length = 0 Then
Log.WriteLog(Now & ":" & "ERROR: ADField can not be empty") ServerLog("ERROR: ADField can not be empty")
ConfOk = False ConfOk = False
End If End If
@ -918,22 +866,22 @@ Public Class CICRadarR
Case "0" Case "0"
Provider = RConfig.GetKeyValue("CICRadarR", "Provider") Provider = RConfig.GetKeyValue("CICRadarR", "Provider")
If Provider.Length = 0 Then If Provider.Length = 0 Then
Log.WriteLog(Now & ":" & "ERROR: Provider can not be empty") ServerLog("ERROR: Provider can not be empty")
ConfOk = False ConfOk = False
End If End If
Case "1" Case "1"
ComPort = RConfig.GetKeyValue("CICRadarR", "COMPORT") ComPort = RConfig.GetKeyValue("CICRadarR", "COMPORT")
If ComPort.Length = 0 Then If ComPort.Length = 0 Then
Log.WriteLog(Now & ":" & "ERROR: ComPort can not be empty") ServerLog("ERROR: ComPort can not be empty")
ConfOk = False ConfOk = False
End If End If
SmsC = RConfig.GetKeyValue("CICRadarR", "SMSC") SmsC = RConfig.GetKeyValue("CICRadarR", "SMSC")
If SmsC.Length = 0 Then If SmsC.Length = 0 Then
Log.WriteLog(Now & ":" & "ERROR: SMSC can not be empty. See http://smsclist.com/downloads/default.txt for valid values") ServerLog("ERROR: SMSC can not be empty. See http://smsclist.com/downloads/default.txt for valid values")
ConfOk = False ConfOk = False
End If End If
Case Else Case Else
Log.WriteLog(Now & ":" & "ERROR: USELOCALMODEM contain invalid configuration. Correct value are 1 or 0") ServerLog("ERROR: USELOCALMODEM contain invalid configuration. Correct value are 1 or 0")
ConfOk = False ConfOk = False
End Select End Select
End If End If
@ -947,18 +895,18 @@ Public Class CICRadarR
ClientArray = Split(ClientList, ",") ClientArray = Split(ClientList, ",")
For i As Integer = 0 To ClientArray.Length - 1 For i As Integer = 0 To ClientArray.Length - 1
Log.WriteLog(Now & ":" & "Loading Shared Secret for Client: " & ClientArray(i)) ServerLog("Loading Shared Secret for Client: " & ClientArray(i))
clientHash.Add(ClientArray(i), EncDec.Decrypt(RConfig.GetKeyValue("Clients", ClientArray(i)), encCode)) clientHash.Add(ClientArray(i), EncDec.Decrypt(RConfig.GetKeyValue("Clients", ClientArray(i)), encCode))
Next Next
If ConfOk = True Then If ConfOk = True Then
Log.WriteLog(Now & ":" & "Loading Configuration...OK") ServerLog("Loading Configuration...OK")
Else Else
Log.WriteLog(Now & ":" & "Loading Configuration...FAILED") ServerLog("Loading Configuration...FAILED")
End If End If
Catch Catch
Log.WriteLog(Now & ":" & "ERROR: Missing CICRadarR.ini from startup path or CICRadarR.ini contains invalid configuration") ServerLog("ERROR: Missing CICRadarR.ini from startup path or CICRadarR.ini contains invalid configuration")
Log.WriteLog(Now & ":" & "Loading Configuration...FAILED") ServerLog("Loading Configuration...FAILED")
End End
End Try End Try
End Sub End Sub

View file

@ -223,6 +223,10 @@ Public Class RADIUSPacket
mServer.SendAsResponse(New RADIUSPacket(RadiusPacketCode.AccessReject, mIdentifier, Nothing, mEndPoint), mAuthenticator) mServer.SendAsResponse(New RADIUSPacket(RadiusPacketCode.AccessReject, mIdentifier, Nothing, mEndPoint), mAuthenticator)
End Sub End Sub
Public Sub SendAccessChallenge(ByVal attributes As RADIUSAttributes)
mServer.SendAsResponse(New RADIUSPacket(RadiusPacketCode.AccessChallenge, mIdentifier, attributes, mEndPoint), mAuthenticator)
End Sub
Private Function XorBytes(ByVal oper1() As Byte, ByVal oper2() As Byte) As Byte() Private Function XorBytes(ByVal oper1() As Byte, ByVal oper2() As Byte) As Byte()
Dim res() As Byte = {} Dim res() As Byte = {}
If oper1.Length <> oper2.Length Then Return res If oper1.Length <> oper2.Length Then Return res