Refactoring: Cut out RDS handling logic, and put into own module.

Still no sms / mail sending.

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

CICRadarR/exceptions/MissingUserException.vb

@@ -0,0 +1,3 @@
+Public Class MissingUserException
+    Inherits Exception
+End Class

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
+