RDSFactor/CICRadarR/CICRadarR.vb

Imports System.DirectoryServices
Imports System.IO
Imports System.Reflection
Imports CICRadarR.SMS
Imports CICRadarR.LogFile
Imports System.Security.Cryptography
Imports System.Text
Imports System
Imports System.Net.Mail

Public Class CICRadarR

    Private DEBUG As Boolean
    Private EnableOTP As Boolean
    Private Log As New LogWriter
    Private UserAccessLog As New LogWriter
    Private secrets As NASAuthList
    Private radius1812 As RADIUSServer
    Private radius1645 As RADIUSServer
    Private userHash As New Hashtable
    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
    Private LaunchTimeOut As Integer = 30 ' in seconds
    Private EnableSMS As Boolean = False
    Private EnableEmail As Boolean = False


    Protected Overrides Sub OnStart(ByVal args() As String)

        Log.filePath = ApplicationPath() & "\log.txt"
        UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt"

        Log.WriteLog("---------------------------------------------------------------------------------------------------")
        Log.WriteLog(Now & ":" & "Starting Service")

        Log.WriteLog(Now & ":" & "Loading Configuration...")
        Call loadConfiguration()
        Log.WriteLog(Now & ":" & "Starting Radius listner ports...")
        Call StartUpServer()
    End Sub

    Public Sub OnstartTest()
        Log.filePath = ApplicationPath() & "\log.txt"
        UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt"

        Log.WriteLog("---------------------------------------------------------------------------------------------------")
        Log.WriteLog(Now & ":" & "Starting Service")

        Log.WriteLog(Now & ":" & "Loading Configuration...")
        Call loadConfiguration()
        Log.WriteLog(Now & ":" & "Starting Radius listner ports...")
        Call StartUpServer()
    End Sub

    Protected Overrides Sub OnStop()
        Log.WriteLog(Now & ":" & "Stopping Radius listner ports...")

    End Sub

    Public Sub OnStopTest()
        Log.WriteLog(Now & ":" & "Stopping Radius listner ports...")

    End Sub

    Public Sub StartUpServer()

        ' First, let's load a list of RADIUS shared secrets
        ' in a NASAuthList object (a glorified Dictionary, basically)
        secrets = New NASAuthList
        ' Populate from DB, I suppose ...

        For Each cl As DictionaryEntry In clientHash
            Log.WriteLog(Now & ":" & "Adding Shared Secret to Radius Server")
            secrets.AddSharedSecret(cl.Key, cl.Value)
        Next
        ' Then, we just create a RADIUS server ...
        Try
            Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1812...")
            radius1812 = New RADIUSServer(1812, AddressOf ProcessPacket1812, secrets)
            Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1812...OK")
        Catch
            Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1812...FAILED")

        End Try

        Try
            Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1645...")
            radius1645 = New RADIUSServer(1645, AddressOf ProcessPacket1645, secrets)
            Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1645...OK")
        Catch
            Log.WriteLog(Now & ":" & "Starting Radius Server on Port 1645...FAILED")

        End Try


     


    End Sub


    ' Every valid RADIUS request generated by the server(s) we created earlier
    ' will fire up the callback procedure. Invalid requests are dropped, per RFC.
    Private Sub ProcessPacket1812(ByVal packet As RADIUSPacket)
        'Console.WriteLine("packet " & Now)
        ProcessPacket(radius1812, packet)
    End Sub

    Private Sub ProcessPacket1645(ByVal packet As RADIUSPacket)
        ProcessPacket(radius1645, packet)
    End Sub



    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)
        Else
            ProcessPacketCSG(server, packet)
        End If
    End Sub
 

    Sub ProcessPacketTSGW(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)

        ' Let's take a look at just authentication requests, 
        ' and drop other requests silently ...

        If packet.Code <> RadiusPacketCode.AccessRequest Then
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. Drop!")

            End If
            Exit Sub
        Else
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Radius packet recived")
            End If
        End If

        Dim LaunchApp As String = ""
        Dim launchTSGW As String = ""
        If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then
            Dim VSAtt As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.VendorSpecific)
            Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
            For Each atts As RADIUSAttribute In VSAtts
                'Dim opt As String = atts.GetHex().Trim
                'Console.WriteLine(atts.GetVendorSpecific.VendorValue.ToString)
                'Select Case opt
                '    Case "4C 41 55 4E 43 48" ' ok, I was lasy. Need to write code to resolve value in (26) Vendor specific. 
                '        LaunchApp = "LAUNCH"
                '    Case "00 00 01 37 2F 06 00 00 00 01"
                '        launchTSGW = "LAUNCH"
                'End Select
                'Console.WriteLine(atts.GetHex())

                Dim opt As String = atts.GetVendorSpecific.VendorValue.ToString

                Select Case UCase(opt)
                    Case "LAUNCH"
                        LaunchApp = "LAUNCH"
                    Case "TSGATEWAY"
                        launchTSGW = "LAUNCH"
                End Select
            Next
            '   LaunchApp = VSAtt.GetString
        End If

        ' Let's see if we have a username present ...
        Dim username As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserName)
        Dim pass As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserPassword)


        If LaunchApp = "LAUNCH" Then ' handle RadiusSession when application launches. Store it and check when connection is made through TS Gateway

            Dim sRadiusSessionId = packet.UserPassword
            Dim attributes As New RADIUSAttributes
            Dim SessionId_Ok As Boolean = False
            Dim sUserName As String = username.GetString.ToLower

            If TSGWSessionIdHash.Contains(sUserName) And TSGWSessionIdTimeStampHash.Contains(sUserName) Then ' user has a session lets check if it valid
                Dim hashTime As DateTime = DirectCast(TSGWSessionIdTimeStampHash(sUserName), DateTime)
                Dim tValid = DateDiff(DateInterval.Minute, hashTime, Now)
                If tValid < SessionTimeOut Then
                    ' check session id
                    If sRadiusSessionId = DirectCast(TSGWSessionIdHash(sUserName), String) Then ' Session id match 
                        SessionId_Ok = True ' Session ok now add launch hash key
                        If TSGWLaunchIdTimeStampHash.Contains(sUserName) Then
                            TSGWLaunchIdTimeStampHash(sUserName) = Now
                        Else
                            TSGWLaunchIdTimeStampHash.Add(sUserName, Now)
                        End If
                        Console.WriteLine(sUserName)
                    End If
                End If

            End If

            If SessionId_Ok Then ' found match in hash table' Return ok
                server.SendAsResponse( _
                            New RADIUSPacket(RadiusPacketCode.AccessAccept, _
                                             packet.Identifier, attributes, _
                                             packet.EndPoint), _
                            packet.Authenticator)
            Else
                server.SendAsResponse( _
                            New RADIUSPacket(RadiusPacketCode.AccessReject, _
                                             packet.Identifier, attributes, _
                                             packet.EndPoint), _
                            packet.Authenticator)
            End If


        ElseIf launchTSGW = "LAUNCH" Then ' TSGateWay Connection 
            Dim sRadiusSessionId = packet.UserPassword
            Dim attributes As New RADIUSAttributes
            Dim proxyState As String
            Dim LaunchId_Ok As Boolean = False
            Dim sUserName As String = username.GetString.ToLower

            Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
            If existProxyState = True Then
                proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute ProxyState=" & proxyState)
                End If
                attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
            End If

            'Check launchHash to see if user hash a valid launch window (default 30 sec.)
            Console.WriteLine(sUserName)
            If TSGWLaunchIdTimeStampHash.Contains(sUserName) = True Then ' user has a launch id lets check if it valid
                Dim hashTime As DateTime = DirectCast(TSGWLaunchIdTimeStampHash(sUserName), DateTime)
                Dim tValid = DateDiff(DateInterval.Second, hashTime, Now)
                If tValid < LaunchTimeOut Then
                    LaunchId_Ok = True ' Launch ok now add launch hash key
                    TSGWLaunchIdTimeStampHash.Remove(sUserName)
                End If
            End If



            If LaunchId_Ok Then ' found match in hash table' Return ok
                server.SendAsResponse( _
                            New RADIUSPacket(RadiusPacketCode.AccessAccept, _
                                             packet.Identifier, attributes, _
                                             packet.EndPoint), _
                            packet.Authenticator)
            Else
                server.SendAsResponse( _
                            New RADIUSPacket(RadiusPacketCode.AccessReject, _
                                             packet.Identifier, attributes, _
                                             packet.EndPoint), _
                            packet.Authenticator)
            End If

        Else
            Dim sid As String = ""
            Dim mobile As String = ""
            Dim email As String = ""
            Dim smsCode As String = ""



            ' If an attribute of a particular type is not found, the function
            ' will return Nothing.
            If username Is Nothing Then
                ' Technically, this case is against RFC, so ... drop.
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. No username pressent.. Drop!")
                End If
                Exit Sub
            End If

            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Processing packet for user: " & username.GetString)
            End If


            Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
            Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute? State=" & existState.ToString)
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a proxy-state attribute? Proxy-State=" & existState.ToString)
            End If

            If existState = True Then  ' Ok we have at packet with the State attribute set. Check if we can identify the authtentication packet. (User provides the sms token)
                Dim state As String
                Dim proxyState As String

                state = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).GetString
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute State=" & state)
                End If


                If existProxyState = True Then
                    proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString
                    If DEBUG = True Then
                        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute State=" & proxyState)
                    End If
                End If


                Dim UserDomain As String = ""
                'lets see if user login using upd or UPN name
                Dim sUserName As String = username.GetString.ToLower
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Username = " & sUserName)
                End If
                Dim sPassword As String = packet.UserPassword
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: SMSToken supplied by the user = " & sPassword)
                End If
                sid = ""
                If InStr(sUserName, "@") > 0 Then 'UPN
                    UserDomain = sUserName
                Else 'UPD
                    'read domain from Hashtable 
                    UserDomain = sUserName
                End If

                sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode)

                Dim attributes As New RADIUSAttributes
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Checking for userHash " & sid)
                End If

                If sid = state Then ' All good allow user access to the Web Interface
                    If DEBUG = True Then
                        UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid match. Sending accept packet to Netscaler")
                    End If
                    If existProxyState = True Then
                        attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
                    End If


                    Dim sGUID As String
                    sGUID = System.Guid.NewGuid.ToString()

                    ' Add the user and guid to the access  master list. This hash will be chech each time an application is launched. This prevents access through TS gateway without going through the Webinterface first.

                    If TSGWSessionIdHash.Contains(UserDomain) Then
                        TSGWSessionIdHash(UserDomain) = sGUID
                    Else
                        TSGWSessionIdHash.Add(UserDomain, sGUID)
                    End If

                    If TSGWSessionIdTimeStampHash.Contains(UserDomain) Then
                        TSGWSessionIdTimeStampHash(UserDomain) = Now
                    Else
                        TSGWSessionIdTimeStampHash.Add(UserDomain, Now)
                    End If



                    Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
                    attributes.Add(guidAttribute)
                    ' send accept packet to the user
                    server.SendAsResponse( _
                   New RADIUSPacket(RadiusPacketCode.AccessAccept, _
                                    packet.Identifier, attributes, _
                                    packet.EndPoint), _
                   packet.Authenticator)
                    UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has successfully authenticated with Token")
                Else
                    If DEBUG = True Then
                        UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid does not match. Sending reject packet to Netscaler")
                    End If

                    server.SendAsResponse( _
                New RADIUSPacket(RadiusPacketCode.AccessReject, _
                                 packet.Identifier, attributes, _
                                 packet.EndPoint), _
                packet.Authenticator)
                    UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has failed to authenticate. Incorrect Token")

                End If

                If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then ' Clean first login hash table
                    TSGWFirstLoginTimeStampHash.Remove(UserDomain)
                    TSGWFirstLoginHash.Remove(UserDomain)
                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 sPassword As String = packet.UserPassword
                If InStr(sUserName, "@") > 0 Then 'UPN
                    UserDomain = sUserName
                Else 'UPD
                    'read domain from Hashtable 
                    '  UserDomain = NetBiosDomain & "\" & sUserName
                    UserDomain = sUserName
                End If

                UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " is trying to log in ...")


                Try
                    Dim dirEntry As New DirectoryEntry("LDAP://" & LDAPDomain, UserDomain, sPassword)

                    Dim obj As Object = dirEntry.NativeObject
                    Dim search As New DirectorySearcher(dirEntry)

                    If InStr(sUserName, "@") > 0 Then
                        search.Filter = "(userPrincipalName=" + sUserName + ")"
                    Else
                        search.Filter = "(SAMAccountName=" + Split(sUserName, "\")(1) + ")"
                    End If
                    'Load the Properties we need from AD
                    search.PropertiesToLoad.Add("distinguishedName")
                    'search.PropertiesToLoad.Add("primaryTelexNumber")
                    If EnableOTP = True Then
                        search.PropertiesToLoad.Add(ADField)
                        search.PropertiesToLoad.Add(ADMailField)
                    End If
                    ' Time to find out if user entered the correct username and pasword 
                    If DEBUG = True Then
                        UserAccessLog.WriteLog(Now & ":" & "DEBUG: 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()
                    '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 aCode As String() = code.Split("/")

                    'Dim userLdap As String = "LDAP://" & LDAPPath & "/" & result.Properties("distinguishedName")(0)
                    'Dim userEntry As New DirectoryEntry(userLdap, UserDomain, sPassword)
                    If EnableOTP = True Then
                        ' smsCode = GenerateCode()

                        ' REMEMBER to put at check for empty phone string
                        Try
                            If EnableSMS = True Then
                                mobile = DirectCast(result.Properties(ADField)(0), String)
                                mobile = Replace(mobile, "+", "")
                                If mobile.Trim.Length = 0 Then
                                    success = False
                                    If DEBUG = True Then
                                        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number for user " & UserDomain)
                                    End If
                                Else
                                    success = True
                                End If
                            End If

                            If EnableEmail = True Then
                                email = DirectCast(result.Properties(ADMailField)(0), String)

                                If InStr(email, "@") = 0 Then
                                    success = False
                                    If DEBUG = True Then
                                        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct email for user " & UserDomain)
                                    End If
                                Else
                                    success = True
                                End If
                            End If
                        Catch
                            If DEBUG = True Then
                                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number or email for user " & UserDomain)
                            End If
                            success = False
                        End Try


                        '   sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
                    Else

                    End If
                    ' sid = UserDomain & "_" & smsCode
                    'userEntry.Properties("primaryTelexNumber").Value = aCode(0) & "/" & smsCode & "/" & aCode(2) & "/" & aCode(3)
                    'userEntry.CommitChanges()
                    'userEntry.Dispose()
                    If 1 = 1 Then ' check if smscode is disabled for the user (Need to write this code)
                        'If userHash.ContainsKey(sid) Then
                        '    userHash(sid) = sPassword
                        '    If DEBUG = True Then
                        '        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Updating userHash " & sid)
                        '    End If
                        'Else
                        '    userHash.Add(sid, sPassword)
                        '    If DEBUG = True Then
                        '        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Adding userHash " & sid)
                        '    End If
                        'End If
                        ' new code stored in AD now send it to the users phone
                        ' Console.WriteLine(smsCode)

                        success = True
                    Else
                        success = False
                    End If
                Catch
                    If DEBUG = True Then
                        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
                    End If
                    success = False
                    'Console.WriteLine("fu...")
                    'Console.WriteLine(ex.Message)
                End Try



                Dim attributes As New RADIUSAttributes
                If success Then ' Yay! Someone guess the password ...
                    Dim sendType As String = ""
                    UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory")
                    If EnableOTP = True Then
                        If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then
                            Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
                            For Each atts As RADIUSAttribute In VSAtts

                                Dim opt As String = atts.GetVendorSpecific.VendorValue.ToString

                                Select Case UCase(opt)
                                    Case "SMS"
                                        sendType = "SMS"
                                    Case "EMAIL"
                                        sendType = "EMAIL"
                                End Select
                            Next
                        Else
                            sendType = "SMS"
                        End If

                        If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then
                            Dim hTime As DateTime = DirectCast(TSGWFirstLoginTimeStampHash(UserDomain), DateTime)
                            Dim tValid = DateDiff(DateInterval.Second, hTime, Now)
                            If tValid >= 5 Then
                                TSGWFirstLoginTimeStampHash.Remove(UserDomain)
                                TSGWFirstLoginHash.Remove(UserDomain)
                            End If
                        End If

                        If TSGWFirstLoginHash.Contains(UserDomain) Then
                            sid = TSGWFirstLoginHash(UserDomain).ToString
                            If DEBUG = True Then
                                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Access token already send to phonenumber " & mobile)
                            End If
                        Else
                            smsCode = GenerateCode()
                            sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
                            If DEBUG = True Then
                                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Sending access token: " & smsCode & " to phonenumber " & mobile)
                            End If
                            TSGWFirstLoginHash.Add(UserDomain, sid)
                            TSGWFirstLoginTimeStampHash.Add(UserDomain, Now)


                            If sendType = "SMS" Then
                                Call SendSMS(mobile, smsCode)
                            Else
                                Call SendEmail(email, smsCode)
                            End If
                        End If

                        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, "julegris") ' test 
                        attributes.Add(state)
                        '  Console.WriteLine("len " & packet.Authenticator.Length.ToString)
                        server.SendAsResponse( _
                            New RADIUSPacket(RadiusPacketCode.AccessChallenge, _
                                             packet.Identifier, attributes, _
                                             packet.EndPoint), _
                            packet.Authenticator)
                        ' If DEBUG = True Then
                        'UserAccessLog.WriteLog(Now & ":" & "DEBUG: 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 
                        ' add session key so user can access applications.

                        Dim sGUID As String
                        sGUID = System.Guid.NewGuid.ToString()
                        If TSGWSessionIdHash.Contains(UserDomain) Then
                            TSGWSessionIdHash(UserDomain) = sGUID
                        Else
                            TSGWSessionIdHash.Add(UserDomain, sGUID)
                        End If

                        If TSGWSessionIdTimeStampHash.Contains(UserDomain) Then
                            TSGWSessionIdTimeStampHash(UserDomain) = Now
                        Else
                            TSGWSessionIdTimeStampHash.Add(UserDomain, Now)
                        End If

                        Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
                        attributes.Add(guidAttribute)
                        server.SendAsResponse( _
                          New RADIUSPacket(RadiusPacketCode.AccessAccept, _
                                           packet.Identifier, attributes, _
                                           packet.EndPoint), _
                          packet.Authenticator)

                    End If
                        ' packetHash.Remove(username.GetString & "_" & pass.GetString)
                    Else ' Wrong username / password ...

                        UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " failed to authenticate agains Active Directory")
                        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 Sub



    Private Sub ProcessPacketCSG(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)

        ' Let's take a look at just authentication requests, 
        ' and drop other requests silently ...

        If packet.Code <> RadiusPacketCode.AccessRequest Then
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. Drop!")
            End If
            Exit Sub

        End If



        ' Let's see if we have a username present ...
        Dim username As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserName)
        Dim pass As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserPassword)
        Dim sid As String = ""
        Dim mobile As String = ""
        Dim smsCode As String = ""
        Dim UserEmail As String = ""


        ' If an attribute of a particular type is not found, the function
        ' will return Nothing.
        If username Is Nothing Then
            ' Technically, this case is against RFC, so ... drop.
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. No username pressent.. Drop!")
            End If
            Exit Sub
        End If

        If DEBUG = True Then
            UserAccessLog.WriteLog(Now & ":" & "DEBUG: Processing packet for user: " & username.GetString)
        End If

        'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then
        '    Exit Sub
        'End If



        Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
        If DEBUG = True Then
            UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute? State=" & existState.ToString)
        End If
        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
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute State=" & state)
            End If
            Dim UserDomain As String = ""
            'lets see if user login using upd or UPN name
            Dim sUserName As String = username.GetString
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Username = " & sUserName)
            End If
            Dim sPassword As String = packet.UserPassword
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: SMSToken supplied by the user = " & sPassword)
            End If
            sid = ""
            If InStr(sUserName, "@") > 0 Then 'UPN
                UserDomain = sUserName
            Else 'UPD
                'read domain from Hashtable 
                UserDomain = NetBiosDomain & "\" & sUserName
            End If

            sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode)
            ' sid = UserDomain & "_" & packet.UserPassword
            Dim attributes As New RADIUSAttributes
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Checking for userHash " & sid)
            End If
            If sid = state Then
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid match. Sending accept packet to Netscaler")
                End If

                server.SendAsResponse( _
               New RADIUSPacket(RadiusPacketCode.AccessAccept, _
                                packet.Identifier, attributes, _
                                packet.EndPoint), _
               packet.Authenticator)
                UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has successfully authenticated with Token")
            Else
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid does not match. Sending reject packet to Netscaler")
                End If

                server.SendAsResponse( _
            New RADIUSPacket(RadiusPacketCode.AccessReject, _
                             packet.Identifier, attributes, _
                             packet.EndPoint), _
            packet.Authenticator)
                UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has failed to authenticate. Incorrect Token")

            End If
        Else ' process the first login

            '  packetHash.Add(username.GetString & "_" & pass.GetString, 0)

            '  Console.WriteLine(username.GetString & " is trying to log in ... ")
            ' Note that an attribute can represent a string, number, IP, etc.
            ' RADAR will not guess that automatically, so use the appropriate
            ' function according to the attribute you're trying to read. Otherwise,
            ' the Value property is just a bunch of bytes as received in the 
            ' RADIUS packet.


            '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
            Dim sPassword As String = packet.UserPassword
            If InStr(sUserName, "@") > 0 Then 'UPN
                UserDomain = sUserName
            Else 'UPD
                'read domain from Hashtable 
                UserDomain = NetBiosDomain & "\" & sUserName
            End If

            UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " is trying to log in ...")



            Try
                Dim dirEntry As New DirectoryEntry("LDAP://" & LDAPDomain, UserDomain, sPassword)

                Dim obj As Object = dirEntry.NativeObject
                Dim search As New DirectorySearcher(dirEntry)

                If InStr(sUserName, "@") > 0 Then
                    search.Filter = "(userPrincipalName=" + sUserName + ")"
                Else
                    search.Filter = "(SAMAccountName=" + sUserName + ")"
                End If
                'Load the Properties we need from AD
                search.PropertiesToLoad.Add("distinguishedName")
                'search.PropertiesToLoad.Add("primaryTelexNumber")
                If EnableOTP = True Then
                    If EnableEmail = True Then
                        search.PropertiesToLoad.Add(ADMailField)
                    End If
                    If EnableSMS = True Then
                        search.PropertiesToLoad.Add(ADField)
                    End If

                End If
                ' Time to find out if user entered the correct username and pasword 
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: 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()
                '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 aCode As String() = code.Split("/")

                'Dim userLdap As String = "LDAP://" & LDAPPath & "/" & result.Properties("distinguishedName")(0)
                'Dim userEntry As New DirectoryEntry(userLdap, UserDomain, sPassword)
                If EnableOTP = True Then
                    smsCode = GenerateCode()

                    ' REMEMBER to put at check for empty phone string
                    If EnableEmail = True Then
                        Try
                            UserEmail = DirectCast(result.Properties(ADMailField)(0), String)

                            If UserEmail.Trim.Length = 0 Or InStr(UserEmail, "@") = 0 Then
                                success = False
                                If DEBUG = True Then
                                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct email for user " & UserDomain)
                                End If
                            Else
                                success = True
                            End If
                        Catch
                            If DEBUG = True Then
                                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct email for user " & UserDomain)
                            End If
                            success = False
                        End Try
                    End If
                    If EnableSMS = True Then
                        Try
                            mobile = DirectCast(result.Properties(ADField)(0), String)
                            mobile = Replace(mobile, "+", "")
                            If mobile.Trim.Length = 0 Then
                                success = False
                                If DEBUG = True Then
                                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number for user " & UserDomain)
                                End If
                            Else
                                success = True
                            End If
                        Catch
                            If DEBUG = True Then
                                UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number for user " & UserDomain)
                            End If
                            success = False
                        End Try

                    End If

                    sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
                End If
                ' sid = UserDomain & "_" & smsCode
                'userEntry.Properties("primaryTelexNumber").Value = aCode(0) & "/" & smsCode & "/" & aCode(2) & "/" & aCode(3)
                'userEntry.CommitChanges()
                'userEntry.Dispose()
                If 1 = 1 Then ' check if smscode is disabled for the user (Need to write this code)
                    'If userHash.ContainsKey(sid) Then
                    '    userHash(sid) = sPassword
                    '    If DEBUG = True Then
                    '        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Updating userHash " & sid)
                    '    End If
                    'Else
                    '    userHash.Add(sid, sPassword)
                    '    If DEBUG = True Then
                    '        UserAccessLog.WriteLog(Now & ":" & "DEBUG: Adding userHash " & sid)
                    '    End If
                    'End If
                    ' new code stored in AD now send it to the users phone
                    ' Console.WriteLine(smsCode)

                    success = True
                Else
                    success = False
                End If
            Catch
                If DEBUG = True Then
                    UserAccessLog.WriteLog(Now & ":" & "DEBUG: Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
                End If
                success = False
               
            End Try


            Dim attributes As New RADIUSAttributes
            If success Then ' Yay! Someone guess the password ...

                UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory")
                If EnableOTP = True Then
                    Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
                    attributes.Add(attr)
                    Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid)
                    attributes.Add(state)
                    '  Console.WriteLine("len " & packet.Authenticator.Length.ToString)
                    server.SendAsResponse( _
                        New RADIUSPacket(RadiusPacketCode.AccessChallenge, _
                                         packet.Identifier, attributes, _
                                         packet.EndPoint), _
                        packet.Authenticator)
                    If EnableSMS = True Then
                        If DEBUG = True Then
                            UserAccessLog.WriteLog(Now & ":" & "DEBUG: Sending access token: " & smsCode & " to phonenumber " & mobile)
                        End If

                        Call SendSMS(mobile, smsCode)
                    End If
                    If EnableEmail = True Then
                        If DEBUG = True Then
                            UserAccessLog.WriteLog(Now & ":" & "DEBUG: Sending access token: " & smsCode & " to email " & UserEmail)
                        End If

                        Call SendEmail(UserEmail, smsCode)
                    End If
                Else ' One time Password not enabled, so we let the user in 
                    server.SendAsResponse( _
                      New RADIUSPacket(RadiusPacketCode.AccessAccept, _
                                       packet.Identifier, attributes, _
                                       packet.EndPoint), _
                      packet.Authenticator)
                End If
                ' packetHash.Remove(username.GetString & "_" & pass.GetString)
            Else ' Wrong username / password ...

                UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " failed to authenticate agains Active Directory")
                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 Sub




    Public Function GenerateCode() As String


        Dim dummy As Integer = 0

        Dim ordRand As New System.Random()
        Dim temp As New System.Collections.ArrayList()
        While temp.Count < 6
            dummy = ordRand.[Next](1, 9)
            If Not temp.Contains(dummy) Then
                temp.Add(dummy)
            End If
        End While
        Dim strVar As String = temp(0).ToString() + temp(1).ToString() + temp(2).ToString() + temp(3).ToString() + temp(4).ToString() + temp(5).ToString()
        Return strVar

    End Function

    Public Sub loadConfiguration()
        Dim ConfOk As Boolean = True
        Dim RConfig As New IniFile
        Try
            RConfig.Load(ApplicationPath() & "\CICRadarR.ini")
            DEBUG = RConfig.GetKeyValue("CICRadarR", "Debug")
            NetBiosDomain = RConfig.GetKeyValue("CICRadarR", "NetBiosDomain")
            If NetBiosDomain.Length = 0 Then
                Log.WriteLog(Now & ":" & "ERROR: NetBiosDomain can not be empty")
                ConfOk = False
            End If
            LDAPDomain = RConfig.GetKeyValue("CICRadarR", "LDAPDomain")
            If LDAPDomain.Length = 0 Then
                Log.WriteLog(Now & ":" & "ERROR: LDAPDomain can not be empty")
                ConfOk = False
            End If

            TSGW = RConfig.GetKeyValue("CICRadarR", "TSGW")

            EnableOTP = RConfig.GetKeyValue("CICRadarR", "EnableOTP")

            If EnableOTP = True Then
                If RConfig.GetKeyValue("CICRadarR", "EnableEmail") = "1" Then
                    EnableEmail = True
                    SenderEmail = RConfig.GetKeyValue("CICRadarR", "SenderEmail")
                    MailServer = RConfig.GetKeyValue("CICRadarR", "MailServer")
                    ADMailField = RConfig.GetKeyValue("CICRadarR", "ADMailField")
                End If

                ADField = RConfig.GetKeyValue("CICRadarR", "ADField")
                If ADField.Length = 0 Then
                    Log.WriteLog(Now & ":" & "ERROR:  ADField can not be empty")
                    ConfOk = False
                End If

                If RConfig.GetKeyValue("CICRadarR", "EnableSMS") = "1" Then
                    EnableSMS = True
                    ModemType = RConfig.GetKeyValue("CICRadarR", "USELOCALMODEM")
                    Select Case ModemType
                        Case "0"
                            Provider = RConfig.GetKeyValue("CICRadarR", "Provider")
                            If Provider.Length = 0 Then
                                Log.WriteLog(Now & ":" & "ERROR:  Provider can not be empty")
                                ConfOk = False
                            End If
                        Case "1"
                            ComPort = RConfig.GetKeyValue("CICRadarR", "COMPORT")
                            If ComPort.Length = 0 Then
                                Log.WriteLog(Now & ":" & "ERROR:  ComPort can not be empty")
                                ConfOk = False
                            End If
                            SmsC = RConfig.GetKeyValue("CICRadarR", "SMSC")
                            If SmsC.Length = 0 Then
                                Log.WriteLog(Now & ":" & "ERROR:  SMSC can not be empty. See http://smsclist.com/downloads/default.txt for valid values")
                                ConfOk = False
                            End If
                        Case Else
                            Log.WriteLog(Now & ":" & "ERROR:  USELOCALMODEM contain invalid configuration. Correct value are 1 or 0")
                            ConfOk = False
                    End Select
                End If

            End If

            Dim ClientList As String = ""
            ClientList = RConfig.GetKeyValue("CICRadarR", "ClientList")

            Dim ClientArray() As String
            ClientArray = Split(ClientList, ",")

            For i As Integer = 0 To ClientArray.Length - 1
                Log.WriteLog(Now & ":" & "Loading Shared Secret for Client: " & ClientArray(i))
                clientHash.Add(ClientArray(i), EncDec.Decrypt(RConfig.GetKeyValue("Clients", ClientArray(i)), encCode))
            Next

            If ConfOk = True Then
                Log.WriteLog(Now & ":" & "Loading Configuration...OK")
            Else
                Log.WriteLog(Now & ":" & "Loading Configuration...FAILED")
            End If
        Catch
            Log.WriteLog(Now & ":" & "ERROR: Missing CICRadarR.ini from startup path or CICRadarR.ini contains invalid configuration")
            Log.WriteLog(Now & ":" & "Loading Configuration...FAILED")
            End
        End Try
    End Sub

    Public Function ApplicationPath() As String
        Return Path.GetDirectoryName([Assembly].GetExecutingAssembly().Location)
    End Function

    Public Function SendSMS(ByVal number As String, ByVal passcode As String) As String

        ' test if using online sms provider or local modem
        If ModemType = 1 Then ' local modem
            Dim modem As New SmsClass(ComPort)
            modem.Opens()
            modem.sendSms(number, passcode, SmsC)
            modem.Closes()
            modem = Nothing
            Return "Ok"
        Else


            Dim baseurl As String = Provider.Split("?")(0)
            Dim client As New System.Net.WebClient()
            ' Add a user agent header in case the requested URI contains a query.

            client.Headers.Add("user-agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR1.0.3705;)")

            Dim parameters As String = Provider.Split("?")(1)
            Dim pary As String() = parameters.Split("&")

            For i As Integer = 0 To pary.Length - 1
                If pary(i).IndexOf("***TEXTMESSAGE***") > 0 Then
                    Dim qpar As String() = pary(i).Split("=")
                    client.QueryString.Add(qpar(0), passcode)
                ElseIf pary(i).IndexOf("***NUMBER***") > 0 Then
                    Dim qpar As String() = pary(i).Split("=")
                    client.QueryString.Add(qpar(0), number)
                Else

                    Dim qpar As String() = pary(i).Split("=")
                    client.QueryString.Add(qpar(0), qpar(1))
                End If
            Next


            Dim data As Stream = client.OpenRead(baseurl)
            Dim reader As New StreamReader(data)
            Dim s As String = reader.ReadToEnd()
            data.Close()
            reader.Close()
            Return (s)
        End If

    End Function

    Public Function SendEmail(email As String, passcode As String) As String


        Dim mail As New MailMessage()
        mail.To.Add(email)
        mail.From = New MailAddress(SenderEmail)
        mail.Subject = "Token: " & passcode
        mail.Body = "Subject contains the token code to login to you site"
        mail.IsBodyHtml = False
        Dim smtp As New SmtpClient(MailServer)


        Try
            smtp.Send(mail)
            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & ": Mail send to: " & email)
            End If
            Return "SEND"
        Catch e As InvalidCastException

            If DEBUG = True Then
                UserAccessLog.WriteLog(Now & " : Debug: " & e.Message)
                UserAccessLog.WriteLog(Now & " : Unable to send mail to: " & email & "  ## Check that MAILSERVER and SENDEREMAIL are configured correctly in smscode.conf. Also check that your Webinterface server is allowed to relay through the mail server specified")
            End If
            Return "FAILED"
        End Try



    End Function

    Private Sub TimerCleanUpHash_Elapsed(sender As System.Object, e As System.Timers.ElapsedEventArgs) Handles TimerCleanUpHash.Elapsed
        ' Clean Session and Launch hash for TSGW
        Try
            Dim Item As DictionaryEntry
            For Each Item In TSGWSessionIdTimeStampHash
                Dim hTime As DateTime = DirectCast(Item.Value, DateTime)
                Dim tValid = DateDiff(DateInterval.Minute, hTime, Now)
                If tValid >= SessionTimeOut Then
                    TSGWSessionIdTimeStampHash.Remove(Item.Key)
                    If TSGWSessionIdHash.Contains(Item.Key) Then
                        TSGWSessionIdHash.Remove(Item.Key)
                    End If
                End If
            Next

            For Each Item In TSGWLaunchIdTimeStampHash
                Dim hTime As DateTime = DirectCast(Item.Value, DateTime)
                Dim tValid = DateDiff(DateInterval.Second, hTime, Now)
                If tValid >= LaunchTimeOut Then
                    TSGWLaunchIdTimeStampHash.Remove(Item.Key)
                End If
            Next
        Catch
        End Try
    End Sub
End Class