mirror of
https://github.com/jakobadam/RDSFactor.git
synced 2025-06-11 06:54:29 +02:00
Refactoring: Cut out RDS handling logic, and put into own module.
Still no sms / mail sending.
This commit is contained in:
Jakob A. Dam
Jakob Aarøe Dam
parent
94c9dc0275
commit
cc67ff7039
3 changed files with 312 additions and 43 deletions
|
|
@ -11,8 +11,15 @@ Imports System.Net.Mail
|
|||
|
||||
Public Class CICRadarR
|
||||
|
||||
Public Shared LDAPDomain As String = ""
|
||||
Public Shared ADField As String = ""
|
||||
Public Shared ADMailField As String = ""
|
||||
|
||||
' TODO: What this?
|
||||
Public Shared encCode As String = "gewsyy#sjs2!"
|
||||
|
||||
Private DEBUG As Boolean
|
||||
Private EnableOTP As Boolean
|
||||
Public Shared EnableOTP As Boolean
|
||||
Private Log As New LogWriter
|
||||
Private UserAccessLog As New LogWriter
|
||||
Private secrets As NASAuthList
|
||||
|
|
@ -22,23 +29,23 @@ Public Class CICRadarR
|
|||
Private packetHash As New Hashtable
|
||||
Private clientHash As New Hashtable
|
||||
Private NetBiosDomain As String = ""
|
||||
Private LDAPDomain As String = ""
|
||||
|
||||
Private Provider As String = ""
|
||||
Private ADField As String = ""
|
||||
Private ADMailField As String = ""
|
||||
|
||||
|
||||
Private ModemType As String = ""
|
||||
Private ComPort As String = ""
|
||||
Private SmsC As String = ""
|
||||
Private MailServer As String = ""
|
||||
Private SenderEmail As String = ""
|
||||
Private encCode As String = "gewsyy#sjs2!"
|
||||
|
||||
Private TSGW As String = ""
|
||||
Private TSGWSessionIdHash As New Hashtable
|
||||
Private TSGWSessionIdTimeStampHash 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 TSGWFirstLoginTimeStampHash As New Hashtable ' Ensure that only one sms is send even if radius need to re-authenticate.
|
||||
Private SessionTimeOut As Integer = 30 ' in minutes
|
||||
Public Shared SessionTimeOut As Integer = 30 ' in minutes
|
||||
Private LaunchTimeOut As Integer = 30 ' in seconds
|
||||
Private EnableSMS As Boolean = False
|
||||
Private EnableEmail As Boolean = False
|
||||
|
|
@ -91,16 +98,13 @@ Public Class CICRadarR
|
|||
Next
|
||||
' Then, we just create a RADIUS server ...
|
||||
Try
|
||||
ServerLog("Starting Radius Server on Port 1812...")
|
||||
radius1812 = New RADIUSServer(1812, AddressOf ProcessPacket1812, secrets)
|
||||
ServerLog("Starting Radius Server on Port 1812...OK")
|
||||
Catch
|
||||
ServerLog("Starting Radius Server on Port 1812...FAILED")
|
||||
|
||||
End Try
|
||||
|
||||
Try
|
||||
ServerLog("Starting Radius Server on Port 1645...")
|
||||
radius1645 = New RADIUSServer(1645, AddressOf ProcessPacket1645, secrets)
|
||||
ServerLog("Starting Radius Server on Port 1645...OK")
|
||||
Catch
|
||||
|
|
@ -133,25 +137,14 @@ Public Class CICRadarR
|
|||
|
||||
Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)
|
||||
Dim muuh As New VendorSpecificAttribute(VendorSpecificType.Generic, "LAUNCH")
|
||||
|
||||
Dim atts As New RADIUSAttributes
|
||||
|
||||
muuh.SetRADIUSAttribute(atts)
|
||||
|
||||
|
||||
'For i As Integer = 0 To muuh.
|
||||
' Dim att As RADIUSAttribute
|
||||
' att = atts(i)
|
||||
' Dim ged As String
|
||||
' ged = att.GetVendorSpecific().VendorValue.ToString()
|
||||
|
||||
|
||||
'Next
|
||||
|
||||
' Dim att As New VendorSpecificAttribute(VendorSpecificType.Generic, "LAUNCH")
|
||||
|
||||
' Dim ost As New RADIUSAttribute(RadiusAttributeType.VendorSpecific, att.VendorName & att.VendorType & att.VendorValue)
|
||||
If TSGW = "1" Then
|
||||
ProcessPacketTSGW(server, packet)
|
||||
Dim rds As New RDSHandler(packet)
|
||||
rds.ProcessRequest()
|
||||
'ProcessPacketTSGW(server, packet)
|
||||
Else
|
||||
ProcessPacketCSG(server, packet)
|
||||
End If
|
||||
|
|
@ -166,10 +159,10 @@ Public Class CICRadarR
|
|||
If packet.Code <> RadiusPacketCode.AccessRequest Then
|
||||
AccessLog("Not a valid radius packet.. Drop!")
|
||||
Exit Sub
|
||||
Else
|
||||
AccessLog("Radius packet recived")
|
||||
End If
|
||||
|
||||
AccessLog("Radius packet recived")
|
||||
|
||||
Dim LaunchApp As String = ""
|
||||
Dim launchTSGW As String = ""
|
||||
If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then
|
||||
|
|
@ -206,7 +199,7 @@ Public Class CICRadarR
|
|||
If LaunchApp = "LAUNCH" Then
|
||||
Dim sRadiusSessionId = packet.UserPassword
|
||||
Dim SessionId_Ok As Boolean = False
|
||||
Dim sUserName As String = username.GetString.ToLower
|
||||
Dim sUserName As String = username.ToString.ToLower
|
||||
|
||||
AccessLog("RDWeb app launch: Checking token validity of user: " & sUserName)
|
||||
|
||||
|
|
@ -239,13 +232,13 @@ Public Class CICRadarR
|
|||
Dim attributes As New RADIUSAttributes
|
||||
Dim proxyState As String
|
||||
Dim LaunchId_Ok As Boolean = False
|
||||
Dim sUserName As String = username.GetString.ToLower
|
||||
Dim sUserName As String = username.ToString.ToLower
|
||||
|
||||
AccessLog("TSGateWay Connection checking token validity of user: " & sUserName)
|
||||
AccessLog("TSGateway Connection checking token validity of user: " & sUserName)
|
||||
|
||||
Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
|
||||
If existProxyState = True Then
|
||||
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString
|
||||
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).ToString
|
||||
AccessLog("Packet contains a state attribute ProxyState=" & proxyState)
|
||||
attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
|
||||
End If
|
||||
|
|
@ -288,7 +281,7 @@ Public Class CICRadarR
|
|||
Exit Sub
|
||||
End If
|
||||
|
||||
AccessLog("Processing packet for user: " & username.GetString)
|
||||
AccessLog("Processing packet for user: " & username.ToString)
|
||||
|
||||
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
|
||||
Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
|
||||
|
|
@ -297,18 +290,18 @@ Public Class CICRadarR
|
|||
Dim state As String
|
||||
Dim proxyState As String
|
||||
|
||||
state = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).GetString
|
||||
state = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).ToString
|
||||
AccessLog("Packet contains a state attribute State=" & state)
|
||||
|
||||
If existProxyState = True Then
|
||||
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString
|
||||
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).ToString
|
||||
AccessLog("Packet contains a state attribute State=" & proxyState)
|
||||
End If
|
||||
|
||||
|
||||
Dim UserDomain As String = ""
|
||||
'lets see if user login using upd or UPN name
|
||||
Dim sUserName As String = username.GetString.ToLower
|
||||
Dim sUserName As String = username.ToString.ToLower
|
||||
Dim sPassword As String = packet.UserPassword
|
||||
|
||||
AccessLog("SMSToken supplied by user: " & sUserName)
|
||||
|
|
@ -364,14 +357,11 @@ Public Class CICRadarR
|
|||
End If
|
||||
|
||||
Else ' process the first login (sending sms token)
|
||||
|
||||
|
||||
|
||||
'Now lets get some information from ad if password is valid
|
||||
Dim success As Boolean = False
|
||||
Dim UserDomain As String = ""
|
||||
'lets see if user login using upd or UPN name
|
||||
Dim sUserName As String = username.GetString.ToLower
|
||||
Dim sUserName As String = username.ToString.ToLower
|
||||
Dim sPassword As String = packet.UserPassword
|
||||
If InStr(sUserName, "@") > 0 Then 'UPN
|
||||
UserDomain = sUserName
|
||||
|
|
@ -595,7 +585,7 @@ Public Class CICRadarR
|
|||
Exit Sub
|
||||
End If
|
||||
|
||||
AccessLog("Processing packet for user: " & username.GetString)
|
||||
AccessLog("Processing packet for user: " & username.ToString)
|
||||
|
||||
'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then
|
||||
' Exit Sub
|
||||
|
|
@ -606,11 +596,11 @@ Public Class CICRadarR
|
|||
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
|
||||
AccessLog("Packet contains a state attribute? State=" & existState.ToString)
|
||||
If existState = True Then ' Ok we have at packet with the State attribute set. Check if we can identify the authtentication packet.
|
||||
Dim state As String = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).GetString
|
||||
Dim state As String = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).ToString
|
||||
AccessLog("Packet contains a state attribute State=" & state)
|
||||
Dim UserDomain As String = ""
|
||||
'lets see if user login using upd or UPN name
|
||||
Dim sUserName As String = username.GetString
|
||||
Dim sUserName As String = username.ToString
|
||||
Dim sPassword As String = packet.UserPassword
|
||||
|
||||
AccessLog("SMSToken supplied by user: " & sUserName)
|
||||
|
|
@ -646,7 +636,7 @@ Public Class CICRadarR
|
|||
Dim success As Boolean = False
|
||||
Dim UserDomain As String = ""
|
||||
'lets see if user login using upd or UPN name
|
||||
Dim sUserName As String = username.GetString
|
||||
Dim sUserName As String = username.ToString
|
||||
Dim sPassword As String = packet.UserPassword
|
||||
If InStr(sUserName, "@") > 0 Then 'UPN
|
||||
UserDomain = sUserName
|
||||
|
|
@ -806,7 +796,7 @@ Public Class CICRadarR
|
|||
|
||||
|
||||
|
||||
Public Function GenerateCode() As String
|
||||
Public Shared Function GenerateCode() As String
|
||||
|
||||
|
||||
Dim dummy As Integer = 0
|
||||
|
|
|
|||
3
CICRadarR/exceptions/MissingUserException.vb
Normal file
3
CICRadarR/exceptions/MissingUserException.vb
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
Public Class MissingUserException
|
||||
Inherits Exception
|
||||
End Class
|
||||
276
CICRadarR/handlers/RDSHandler.vb
Normal file
276
CICRadarR/handlers/RDSHandler.vb
Normal file
|
|
@ -0,0 +1,276 @@
|
|||
Imports System.DirectoryServices
|
||||
|
||||
Public Class RDSHandler
|
||||
|
||||
Private Shared userSessions As New Hashtable
|
||||
Private Shared sessionTimestamps As New Hashtable
|
||||
|
||||
Private Shared userSidTokens As New Hashtable
|
||||
Private Shared tokenTimestamps As New Hashtable
|
||||
|
||||
Private mPacket As RADIUSPacket
|
||||
|
||||
Private packetUsername As String
|
||||
Private packetPassword As String
|
||||
Private packetSessionId As String
|
||||
Private packetChallangeCode As String
|
||||
|
||||
' RDS specific values
|
||||
Private mIsAppLaunchRequest As Boolean
|
||||
Private mIsGatewayRequest As Boolean
|
||||
Private mIsSMSRequest As Boolean
|
||||
Private mIsEmailRequest As Boolean
|
||||
|
||||
Private mHasState As Boolean
|
||||
Private mHasProxyState As Boolean
|
||||
Private mProxyState As RADIUSAttribute
|
||||
Private mState As RADIUSAttribute
|
||||
|
||||
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 TSGWFirstLoginTimeStampHash As New Hashtable ' Ensure that only one sms is send even if radius need to re-authenticate.
|
||||
|
||||
Public Sub New(packet As RADIUSPacket)
|
||||
mPacket = packet
|
||||
End Sub
|
||||
|
||||
Public Sub ProcessRequest()
|
||||
ExtractAttributes()
|
||||
|
||||
If ValidPacket() = False Then
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If mIsAppLaunchRequest Then
|
||||
ProcessAppLaunchRequest()
|
||||
ElseIf mIsGatewayRequest Then
|
||||
ProcessGatewayRequest()
|
||||
ElseIf mHasState Then
|
||||
ProcessChallengeResponse()
|
||||
Else
|
||||
ProcessAccessRequest()
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub ProcessAppLaunchRequest()
|
||||
Console.WriteLine("ProcessAppLaunchRequest")
|
||||
|
||||
Dim sessionId = userSessions(packetUsername)
|
||||
Dim sessionTimestamp = sessionTimestamps(packetUsername)
|
||||
|
||||
If sessionId = Nothing Or sessionTimestamp = Nothing Then
|
||||
Console.WriteLine("Rejecting Access-Request to open app")
|
||||
mPacket.RejectAccessRequest()
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim tValid = DateDiff(DateInterval.Minute, sessionTimestamp, Now)
|
||||
If tValid < CICRadarR.SessionTimeOut Then
|
||||
If packetSessionId = sessionId Then
|
||||
Console.WriteLine("Accepting Request to open app")
|
||||
' Pro-long open window
|
||||
sessionTimestamps(sessionId) = Now
|
||||
mPacket.AcceptAccessRequest()
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
Console.WriteLine("Token timed out")
|
||||
mPacket.RejectAccessRequest()
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub ProcessGatewayRequest()
|
||||
Console.WriteLine("Process Gateway Request")
|
||||
|
||||
Dim sessionId = userSessions(packetUsername)
|
||||
Dim sessionTimestamp = sessionTimestamps(packetUsername)
|
||||
Dim attributes As New RADIUSAttributes
|
||||
|
||||
If sessionId = Nothing Or sessionTimestamp = Nothing Then
|
||||
Console.WriteLine("No user session... User must re-authenticate")
|
||||
mPacket.RejectAccessRequest()
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If mHasProxyState Then
|
||||
attributes.Add(mProxyState)
|
||||
End If
|
||||
|
||||
Dim tValid = DateDiff(DateInterval.Minute, sessionTimestamp, Now)
|
||||
If tValid < CICRadarR.SessionTimeOut Then
|
||||
Console.WriteLine("Accepting Reuqest to open app")
|
||||
sessionTimestamps(sessionId) = Now
|
||||
mPacket.AcceptAccessRequest(attributes)
|
||||
Exit Sub
|
||||
Else
|
||||
Console.WriteLine("Session IDs did not match")
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Public Sub ProcessAccessRequest()
|
||||
Console.WriteLine("ProcessAccessRequest")
|
||||
Try
|
||||
Dim ldapResult = Authenticate()
|
||||
|
||||
If CICRadarR.EnableOTP Then
|
||||
TwoFactorChallenge()
|
||||
Exit Sub
|
||||
Else
|
||||
Accept()
|
||||
End If
|
||||
Catch ex As Exception
|
||||
mPacket.RejectAccessRequest()
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Sub Accept()
|
||||
Dim sGUID As String = System.Guid.NewGuid.ToString()
|
||||
userSessions(packetUsername) = sGUID
|
||||
sessionTimestamps(packetUsername) = Now
|
||||
|
||||
Dim attributes As New RADIUSAttributes
|
||||
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
|
||||
|
||||
attributes.Add(guidAttribute)
|
||||
mPacket.AcceptAccessRequest(attributes)
|
||||
End Sub
|
||||
|
||||
Private Sub ProcessChallengeResponse()
|
||||
Console.WriteLine("ProcessChallengeResponse")
|
||||
Dim sid = EncDec.Encrypt(packetUsername & "_" & packetChallangeCode, CICRadarR.encCode)
|
||||
Dim mStateStr = mState.ToString
|
||||
If sid = mState.ToString Then
|
||||
Accept()
|
||||
Else
|
||||
mPacket.RejectAccessRequest()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub TwoFactorChallenge()
|
||||
Dim code = CICRadarR.GenerateCode
|
||||
Dim sid = EncDec.Encrypt(packetUsername & "_" & code, CICRadarR.encCode) 'generate unique code
|
||||
Console.WriteLine("Access Challange Code: " & code)
|
||||
|
||||
userSidTokens(packetUsername) = sid
|
||||
tokenTimestamps(packetUsername) = Now
|
||||
|
||||
If mIsSMSRequest Then
|
||||
Console.WriteLine("SMS: ")
|
||||
ElseIf mIsEmailRequest Then
|
||||
Console.WriteLine("Email: ")
|
||||
End If
|
||||
|
||||
Dim attributes As New RADIUSAttributes
|
||||
|
||||
Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
|
||||
Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid)
|
||||
|
||||
attributes.Add(attr)
|
||||
attributes.Add(state)
|
||||
|
||||
mPacket.SendAccessChallenge(attributes)
|
||||
|
||||
End Sub
|
||||
|
||||
Private Function Authenticate() As System.DirectoryServices.SearchResult
|
||||
Dim password As String = mPacket.UserPassword
|
||||
Dim ldapDomain As String = CICRadarR.LDAPDomain
|
||||
|
||||
Dim dirEntry As New DirectoryEntry("LDAP://" & ldapDomain, packetUsername, password)
|
||||
|
||||
Dim obj As Object = dirEntry.NativeObject
|
||||
Dim search As New DirectorySearcher(dirEntry)
|
||||
|
||||
If InStr(packetUsername, "@") > 0 Then
|
||||
search.Filter = "(userPrincipalName=" + packetUsername + ")"
|
||||
Else
|
||||
search.Filter = "(SAMAccountName=" + Split(packetUsername, "\")(1) + ")"
|
||||
End If
|
||||
|
||||
search.PropertiesToLoad.Add("distinguishedName")
|
||||
If CICRadarR.EnableOTP = True Then
|
||||
search.PropertiesToLoad.Add(CICRadarR.ADField)
|
||||
search.PropertiesToLoad.Add(CICRadarR.ADMailField)
|
||||
End If
|
||||
|
||||
Console.WriteLine("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & packetUsername)
|
||||
Dim result = search.FindOne()
|
||||
|
||||
If IsDBNull(result) Then
|
||||
Console.WriteLine("Failed to authenticate with Active Directory")
|
||||
Throw New MissingUserException
|
||||
End If
|
||||
|
||||
Return result
|
||||
End Function
|
||||
|
||||
Private Function LdapGetNumber(result As SearchResult) As String
|
||||
Dim mobile = result.Properties(CICRadarR.ADField)(0)
|
||||
mobile = Replace(mobile, "+", "")
|
||||
If mobile.Trim.Length = 0 Then
|
||||
Console.WriteLine("Unable to find correct phone number for user " & packetUsername)
|
||||
End If
|
||||
Return mobile
|
||||
End Function
|
||||
|
||||
Private Function LdapGetEmail(result As SearchResult) As String
|
||||
Dim email = result.Properties(CICRadarR.ADMailField)(0)
|
||||
|
||||
If InStr(email, "@") = 0 Then
|
||||
Console.WriteLine("Unable to find correct email for user " & packetUsername)
|
||||
End If
|
||||
Return email
|
||||
End Function
|
||||
|
||||
Private Function ValidPacket()
|
||||
If packetUsername Is Nothing Then
|
||||
Console.WriteLine("Not a valid radius packet.. No username present.. Drop!")
|
||||
Return False
|
||||
End If
|
||||
Return True
|
||||
End Function
|
||||
|
||||
Private Sub ExtractAttributes()
|
||||
mHasState = mPacket.Attributes.AttributeExists(RadiusAttributeType.State)
|
||||
mHasProxyState = mPacket.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
|
||||
|
||||
If mHasState Then
|
||||
mState = mPacket.Attributes.GetFirstAttribute(RadiusAttributeType.State)
|
||||
Console.WriteLine("State:" & mState.ToString)
|
||||
End If
|
||||
If mHasProxyState Then
|
||||
mProxyState = mPacket.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState)
|
||||
Console.WriteLine("ProxyState:" & mProxyState.ToString)
|
||||
End If
|
||||
|
||||
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
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue