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

    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
    Public Shared 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 Provider As String = ""


    Private ModemType As String = ""
    Private ComPort As String = ""
    Private SmsC As String = ""
    Private MailServer As String = ""
    Private SenderEmail As String = ""

    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.
    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


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

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

        Log.WriteLog("---------------------------------------------------------------------------------------------------")
        ServerLog("Starting Service")
        ServerLog("Loading Configuration...")
        Call loadConfiguration()
        ServerLog("Starting Radius listner ports...")
        Call StartUpServer()
    End Sub

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

        ServerLog("---------------------------------------------------------------------------------------------------")
        ServerLog("Starting Service")
        ServerLog("Loading Configuration...")
        Call loadConfiguration()
        ServerLog("Starting Radius listner ports...")
        Call StartUpServer()
    End Sub

    Protected Overrides Sub OnStop()
        ServerLog("Stopping Radius listner ports...")

    End Sub

    Public Sub OnStopTest()
        ServerLog("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
            ServerLog("Adding Shared Secret to Radius Server")
            secrets.AddSharedSecret(cl.Key, cl.Value)
        Next
        ' Then, we just create a RADIUS server ...
        Try
            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
            radius1645 = New RADIUSServer(1645, AddressOf ProcessPacket1645, secrets)
            ServerLog("Starting Radius Server on Port 1645...OK")
        Catch
            ServerLog("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)
        If packet.IsValid Then
            ProcessPacket(radius1812, packet)
        Else
            Console.WriteLine("Packet is not valid. Dropping.")
        End If
    End Sub

    Private Sub ProcessPacket1645(ByVal packet As RADIUSPacket)
        If packet.IsValid Then
            ProcessPacket(radius1645, packet)
        Else
            Console.WriteLine("Packet is not valid. Dropping.")
        End If
    End Sub

    Private Sub AccessLog(ByVal message)
        If DEBUG = True Then
            UserAccessLog.WriteLog(Now & ": DEBUG: " & message)
        End If
    End Sub

    Private Sub ServerLog(ByVal message)
        Log.WriteLog(Now & ":" & message)
    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)

        If TSGW = "1" Then
            Dim rds As New RDSHandler(packet)
            rds.ProcessRequest()
            '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
            AccessLog("Not a valid radius packet.. Drop!")
            Exit Sub
        End If

        AccessLog("Radius packet recived")

        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
            Dim sRadiusSessionId = packet.UserPassword
            Dim SessionId_Ok As Boolean = False
            Dim sUserName As String = username.ToString.ToLower

            AccessLog("RDWeb app launch: Checking token validity of user: " & sUserName)

            If TSGWSessionIdHash.Contains(sUserName) And TSGWSessionIdTimeStampHash.Contains(sUserName) Then
                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
                        If TSGWLaunchIdTimeStampHash.Contains(sUserName) Then
                            TSGWLaunchIdTimeStampHash(sUserName) = Now
                        Else
                            TSGWLaunchIdTimeStampHash.Add(sUserName, Now)
                        End If
                    End If
                End If

            End If

            If SessionId_Ok Then
                packet.AcceptAccessRequest()
            Else
                packet.RejectAccessRequest()
            End If

        ElseIf launchTSGW = "LAUNCH" Then

            Dim sRadiusSessionId = packet.UserPassword
            Dim attributes As New RADIUSAttributes
            Dim proxyState As String
            Dim LaunchId_Ok As Boolean = False
            Dim sUserName As String = username.ToString.ToLower

            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).ToString
                AccessLog("Packet contains a state attribute ProxyState=" & proxyState)
                attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
            End If

            'Check launchHash to see if user hash a valid launch window (default 30 sec.)

            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
                    AccessLog("User " & sUserName & " has valid token.")
                    LaunchId_Ok = True ' Launch ok now add launch hash key
                    TSGWLaunchIdTimeStampHash.Remove(sUserName)
                Else
                    AccessLog("Token of " & sUserName & " timed out.")
                End If
            Else
                AccessLog(sUserName & " has no entry in db.")
            End If

            If LaunchId_Ok Then ' found match in hash table' Return ok
                packet.AcceptAccessRequest(attributes)
            Else
                packet.RejectAccessRequest()
            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.
                AccessLog("Not a valid radius packet.. No username present.. Drop!")
                Exit Sub
            End If

            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)

            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).ToString
                AccessLog("Packet contains a state attribute State=" & state)

                If existProxyState = True Then
                    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.ToString.ToLower
                Dim sPassword As String = packet.UserPassword

                AccessLog("SMSToken supplied by user: " & sUserName)

                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

                AccessLog("Checking for userHash " & sid)

                If sid = state Then ' All good allow user access to the Web Interface
                    AccessLog("State and Sid match. Sending accept packet to Netscaler")
                    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)
                    packet.AcceptAccessRequest(attributes)
                Else
                    packet.RejectAccessRequest()
                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.ToString.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

                AccessLog("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 
                    AccessLog("Authenticating: LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain)
                    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
                                    AccessLog("Unable to find correct phone number for user " & UserDomain)
                                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
                                    AccessLog("Unable to find correct email for user " & UserDomain)
                                Else
                                    success = True
                                End If
                            End If
                        Catch
                            AccessLog("Unable to find correct phone number or email for user " & UserDomain)
                            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
                        '        AccessLog("Updating userHash " & sid)
                        '    End If
                        'Else
                        '    userHash.Add(sid, sPassword)
                        '    If DEBUG = True Then
                        '        AccessLog("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
                    AccessLog("Failed to authenticate user against Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
                    success = False
                End Try


                Dim attributes As New RADIUSAttributes
                If success Then ' Yay! Someone guess the password ...
                    Dim sendType As String = ""
                    AccessLog("User " & UserDomain & " authenticated against 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
                            AccessLog("Access token already send to phonenumber " & mobile)
                        Else
                            smsCode = GenerateCode()
                            sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
                            AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
                            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")
                        Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid)

                        attributes.Add(attr)
                        attributes.Add(state)

                        packet.SendAccessChallenge(attributes)

                    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)
                        packet.AcceptAccessRequest(attributes)
                    End If
                    ' packetHash.Remove(username.GetString & "_" & pass.GetString)
                Else
                    AccessLog("User " & UserDomain & " failed to authenticate against Active Directory")
                    packet.RejectAccessRequest()
                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
            AccessLog("Not a valid radius packet.. Drop!")
            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.
            AccessLog("Not a valid radius packet.. No username pressent.. Drop!")
            Exit Sub
        End If

        AccessLog("Processing packet for user: " & username.ToString)

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



        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).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.ToString
            Dim sPassword As String = packet.UserPassword

            AccessLog("SMSToken supplied by user: " & sUserName)

            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)
            AccessLog("Checking for userHash " & sid)
            If sid = state Then
                packet.AcceptAccessRequest()
            Else
                packet.RejectAccessRequest()
            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.ToString
            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

            AccessLog("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 
                AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)

                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
                                AccessLog("Unable to find correct email for user " & UserDomain)
                            Else
                                success = True
                            End If
                        Catch
                            AccessLog("Unable to find correct email for user " & UserDomain)
                            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
                                AccessLog("Unable to find correct phone number for user " & UserDomain)
                            Else
                                success = True
                            End If
                        Catch
                            AccessLog("Unable to find correct phone number for user " & UserDomain)
                            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
                    '        AccessLog("Updating userHash " & sid)
                    '    End If
                    'Else
                    '    userHash.Add(sid, sPassword)
                    '    If DEBUG = True Then
                    '        AccessLog("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
                AccessLog("Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
                success = False
            End Try


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

                AccessLog("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
                        AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
                        Call SendSMS(mobile, smsCode)
                    End If
                    If EnableEmail = True Then
                        AccessLog("Sending access token: " & smsCode & " to email " & UserEmail)
                        Call SendEmail(UserEmail, smsCode)
                    End If
                Else
                    AccessLog("One time Password not enabled, so we let the user in")
                    packet.AcceptAccessRequest()
                End If
                ' packetHash.Remove(username.GetString & "_" & pass.GetString)
            Else ' Wrong username / password ...

                AccessLog("User " & UserDomain & " failed to authenticate against 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 Shared 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
                ServerLog("ERROR: NetBiosDomain can not be empty")
                ConfOk = False
            End If
            LDAPDomain = RConfig.GetKeyValue("CICRadarR", "LDAPDomain")
            If LDAPDomain.Length = 0 Then
                ServerLog("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
                    ServerLog("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
                                ServerLog("ERROR:  Provider can not be empty")
                                ConfOk = False
                            End If
                        Case "1"
                            ComPort = RConfig.GetKeyValue("CICRadarR", "COMPORT")
                            If ComPort.Length = 0 Then
                                ServerLog("ERROR:  ComPort can not be empty")
                                ConfOk = False
                            End If
                            SmsC = RConfig.GetKeyValue("CICRadarR", "SMSC")
                            If SmsC.Length = 0 Then
                                ServerLog("ERROR:  SMSC can not be empty. See http://smsclist.com/downloads/default.txt for valid values")
                                ConfOk = False
                            End If
                        Case Else
                            ServerLog("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
                ServerLog("Loading Shared Secret for Client: " & ClientArray(i))
                clientHash.Add(ClientArray(i), EncDec.Decrypt(RConfig.GetKeyValue("Clients", ClientArray(i)), encCode))
            Next

            If ConfOk = True Then
                ServerLog("Loading Configuration...OK")
            Else
                ServerLog("Loading Configuration...FAILED")
            End If
        Catch
            ServerLog("ERROR: Missing CICRadarR.ini from startup path or CICRadarR.ini contains invalid configuration")
            ServerLog("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
                AccessLog(Now & ": Mail send to: " & email)
            End If
            Return "SEND"
        Catch e As InvalidCastException

            If DEBUG = True Then
                AccessLog(Now & " : Debug: " & e.Message)
                AccessLog(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