Extracting Packet attributes in constructor

This commit is contained in:
Jakob A. Dam 2015-04-08 13:11:57 +02:00 committed by Jakob Aarøe Dam
parent 6afe01e932
commit e10bb5f6aa

View file

@ -9,17 +9,14 @@ Public Class RDSHandler
Private Shared tokenTimestamps As New Hashtable Private Shared tokenTimestamps As New Hashtable
Private mPacket As RADIUSPacket Private mPacket As RADIUSPacket
Private mUsername As String
Private packetUsername As String Private mPassword As String
Private packetPassword As String
Private packetSessionId As String
Private packetChallangeCode As String
' RDS specific values ' RDS specific values
Private mIsAppLaunchRequest As Boolean Private mIsAppLaunchRequest As Boolean
Private mIsGatewayRequest As Boolean Private mIsGatewayRequest As Boolean
Private mIsSMSRequest As Boolean Private mUseSMSFactor As Boolean
Private mIsEmailRequest As Boolean Private mUseEmailFactor As Boolean
Private TSGWLaunchIdTimeStampHash As New Hashtable Private TSGWLaunchIdTimeStampHash As New Hashtable
Private TSGWFirstLoginHash As New Hashtable ' Ensure that only one sms is send even if radius need to re-authenticate. Private TSGWFirstLoginHash As New Hashtable ' Ensure that only one sms is send even if radius need to re-authenticate.
@ -27,11 +24,37 @@ Public Class RDSHandler
Public Sub New(packet As RADIUSPacket) Public Sub New(packet As RADIUSPacket)
mPacket = packet mPacket = packet
mUsername = mPacket.UserName
mPassword = mPacket.UserPassword
CleanUsername()
For Each atts As RADIUSAttribute In mPacket.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
Dim value As String = atts.GetVendorSpecific.VendorValue.ToString
Select Case UCase(value)
Case "LAUNCH"
mIsAppLaunchRequest = True
Case "TSGATEWAY"
mIsGatewayRequest = True
Case "SMS"
mUseSMSFactor = True
Case "EMAIL"
mUseEmailFactor = True
End Select
Next
End Sub
Private Sub CleanUsername()
' RD Gateway sends EXAMPLE\username
' RD Web sends example\username or - TODO - even example.com\username
If Not mUsername = Nothing Then
mUsername = mUsername.ToLower
End If
End Sub End Sub
Public Sub ProcessRequest() Public Sub ProcessRequest()
ExtractAttributes()
If mIsAppLaunchRequest Then If mIsAppLaunchRequest Then
ProcessAppLaunchRequest() ProcessAppLaunchRequest()
ElseIf mIsGatewayRequest Then ElseIf mIsGatewayRequest Then
@ -45,8 +68,11 @@ Public Class RDSHandler
Public Sub ProcessAppLaunchRequest() Public Sub ProcessAppLaunchRequest()
Console.WriteLine("ProcessAppLaunchRequest") Console.WriteLine("ProcessAppLaunchRequest")
Dim sessionId = userSessions(packetUsername) ' When the packet is an AppLaunchRequest the password attribute contains the session id!
Dim sessionTimestamp = sessionTimestamps(packetUsername) Dim packetSessionId = mPassword
Dim sessionId = userSessions(mUsername)
Dim sessionTimestamp = sessionTimestamps(mUsername)
If sessionId = Nothing Or sessionTimestamp = Nothing Then If sessionId = Nothing Or sessionTimestamp = Nothing Then
Console.WriteLine("Rejecting Access-Request to open app") Console.WriteLine("Rejecting Access-Request to open app")
@ -67,14 +93,13 @@ Public Class RDSHandler
Console.WriteLine("Token timed out") Console.WriteLine("Token timed out")
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
End Sub End Sub
Public Sub ProcessGatewayRequest() Public Sub ProcessGatewayRequest()
Console.WriteLine("Process Gateway Request") Console.WriteLine("Gateway Request for user: " & mUsername)
Dim sessionId = userSessions(packetUsername) Dim sessionId = userSessions(mUsername)
Dim sessionTimestamp = sessionTimestamps(packetUsername) Dim sessionTimestamp = sessionTimestamps(mUsername)
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
If sessionId = Nothing Or sessionTimestamp = Nothing Then If sessionId = Nothing Or sessionTimestamp = Nothing Then
@ -128,8 +153,8 @@ Public Class RDSHandler
Private Sub Accept() Private Sub Accept()
Console.WriteLine("Accept") Console.WriteLine("Accept")
Dim sGUID As String = System.Guid.NewGuid.ToString() Dim sGUID As String = System.Guid.NewGuid.ToString()
userSessions(packetUsername) = sGUID userSessions(mUsername) = sGUID
sessionTimestamps(packetUsername) = Now sessionTimestamps(mUsername) = Now
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID) Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
@ -140,9 +165,12 @@ Public Class RDSHandler
Private Sub ProcessChallengeResponse() Private Sub ProcessChallengeResponse()
Console.WriteLine("ProcessChallengeResponse") Console.WriteLine("ProcessChallengeResponse")
' When the packet is an Challange-Response the password attr. contains the token
Dim challangeCode = mPassword
Dim state = mPacket.Attributes.GetFirstAttribute(RadiusAttributeType.State) Dim state = mPacket.Attributes.GetFirstAttribute(RadiusAttributeType.State)
Dim sid = EncDec.Encrypt(packetUsername & "_" & packetChallangeCode, CICRadarR.encCode) Dim sid = EncDec.Encrypt(mUsername & "_" & challangeCode, CICRadarR.encCode)
If sid = state.ToString Then If sid = state.ToString Then
Accept() Accept()
Else Else
@ -152,15 +180,15 @@ Public Class RDSHandler
Private Sub TwoFactorChallenge() Private Sub TwoFactorChallenge()
Dim code = CICRadarR.GenerateCode Dim code = CICRadarR.GenerateCode
Dim sid = EncDec.Encrypt(packetUsername & "_" & code, CICRadarR.encCode) 'generate unique code Dim sid = EncDec.Encrypt(mUsername & "_" & code, CICRadarR.encCode) 'generate unique code
Console.WriteLine("Access Challange Code: " & code) Console.WriteLine("Access Challange Code: " & code)
userSidTokens(packetUsername) = sid userSidTokens(mUsername) = sid
tokenTimestamps(packetUsername) = Now tokenTimestamps(mUsername) = Now
If mIsSMSRequest Then If mUseSMSFactor Then
Console.WriteLine("SMS: ") Console.WriteLine("SMS: ")
ElseIf mIsEmailRequest Then ElseIf mUseEmailFactor Then
Console.WriteLine("Email: ") Console.WriteLine("Email: ")
End If End If
@ -173,24 +201,23 @@ Public Class RDSHandler
attributes.Add(state) attributes.Add(state)
mPacket.SendAccessChallenge(attributes) mPacket.SendAccessChallenge(attributes)
End Sub End Sub
Private Function Authenticate() As System.DirectoryServices.SearchResult Private Function Authenticate() As System.DirectoryServices.SearchResult
Dim password As String = mPacket.UserPassword Dim password As String = mPacket.UserPassword
Dim ldapDomain As String = CICRadarR.LDAPDomain Dim ldapDomain As String = CICRadarR.LDAPDomain
Console.WriteLine("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & packetUsername) Console.WriteLine("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & mUsername)
Console.WriteLine("Passowrd: " & password) Console.WriteLine("Passowrd: " & password)
Dim dirEntry As New DirectoryEntry("LDAP://" & ldapDomain, packetUsername, password) Dim dirEntry As New DirectoryEntry("LDAP://" & ldapDomain, mUsername, password)
Dim obj As Object = dirEntry.NativeObject Dim obj As Object = dirEntry.NativeObject
Dim search As New DirectorySearcher(dirEntry) Dim search As New DirectorySearcher(dirEntry)
If InStr(packetUsername, "@") > 0 Then If InStr(mUsername, "@") > 0 Then
search.Filter = "(userPrincipalName=" + packetUsername + ")" search.Filter = "(userPrincipalName=" + mUsername + ")"
Else Else
search.Filter = "(SAMAccountName=" + Split(packetUsername, "\")(1) + ")" search.Filter = "(SAMAccountName=" + Split(mUsername, "\")(1) + ")"
End If End If
search.PropertiesToLoad.Add("distinguishedName") search.PropertiesToLoad.Add("distinguishedName")
@ -213,7 +240,7 @@ Public Class RDSHandler
Dim mobile = result.Properties(CICRadarR.ADField)(0) Dim mobile = result.Properties(CICRadarR.ADField)(0)
mobile = Replace(mobile, "+", "") mobile = Replace(mobile, "+", "")
If mobile.Trim.Length = 0 Then If mobile.Trim.Length = 0 Then
Console.WriteLine("Unable to find correct phone number for user " & packetUsername) Console.WriteLine("Unable to find correct phone number for user " & mUsername)
End If End If
Return mobile Return mobile
End Function End Function
@ -222,37 +249,10 @@ Public Class RDSHandler
Dim email = result.Properties(CICRadarR.ADMailField)(0) Dim email = result.Properties(CICRadarR.ADMailField)(0)
If InStr(email, "@") = 0 Then If InStr(email, "@") = 0 Then
Console.WriteLine("Unable to find correct email for user " & packetUsername) Console.WriteLine("Unable to find correct email for user " & mUsername)
End If End If
Return email Return email
End Function End Function
Private Sub ExtractAttributes()
packetUsername = mPacket.UserName.ToLower
packetPassword = mPacket.UserPassword
' When the packet is an AppLaunchRequest the password attribute contains the session id!
packetSessionId = packetPassword
' When the packet is an Challange-Response the password attr. contains the token
packetChallangeCode = packetPassword
For Each atts As RADIUSAttribute In mPacket.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
Dim value As String = atts.GetVendorSpecific.VendorValue.ToString
Select Case UCase(value)
Case "LAUNCH"
mIsAppLaunchRequest = True
Case "TSGATEWAY"
mIsGatewayRequest = True
Case "SMS"
mIsSMSRequest = True
Case "EMAIL"
mIsEmailRequest = True
End Select
Next
End Sub
End Class End Class