From cc67ff7039735debf062de70c79c100dfb6fc873 Mon Sep 17 00:00:00 2001 From: "Jakob A. Dam" Date: Mon, 30 Mar 2015 15:16:50 +0200 Subject: [PATCH] Refactoring: Cut out RDS handling logic, and put into own module. Still no sms / mail sending. --- CICRadarR/CICRadarR.vb | 76 +++-- CICRadarR/exceptions/MissingUserException.vb | 3 + CICRadarR/handlers/RDSHandler.vb | 276 +++++++++++++++++++ 3 files changed, 312 insertions(+), 43 deletions(-) create mode 100644 CICRadarR/exceptions/MissingUserException.vb create mode 100644 CICRadarR/handlers/RDSHandler.vb diff --git a/CICRadarR/CICRadarR.vb b/CICRadarR/CICRadarR.vb index 4d12af0..17ed80f 100644 --- a/CICRadarR/CICRadarR.vb +++ b/CICRadarR/CICRadarR.vb @@ -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 diff --git a/CICRadarR/exceptions/MissingUserException.vb b/CICRadarR/exceptions/MissingUserException.vb new file mode 100644 index 0000000..6710dcb --- /dev/null +++ b/CICRadarR/exceptions/MissingUserException.vb @@ -0,0 +1,3 @@ +Public Class MissingUserException + Inherits Exception +End Class diff --git a/CICRadarR/handlers/RDSHandler.vb b/CICRadarR/handlers/RDSHandler.vb new file mode 100644 index 0000000..8e407dc --- /dev/null +++ b/CICRadarR/handlers/RDSHandler.vb @@ -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 +