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 = ""
    Public Shared EnableOTP As Boolean
    ' TODO: What this?
    Public Shared encCode As String = "gewsyy#sjs2!"

    Private Shared DEBUG As Boolean

    Private Shared UserAccessLog As New LogWriter
    Private Shared Log 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

    Public Shared NetBiosDomain As String = ""

    Private Shared Provider As String = ""


    Private Shared ModemType As String = ""
    Private Shared ComPort As String = ""
    Private Shared SmsC As String = ""
    Private Shared MailServer As String = ""
    Private Shared 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
    Public Shared LaunchTimeOut As Integer = 30 ' in seconds
    Public Shared EnableSMS As Boolean = False
    Public Shared 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)
        ProcessPacket(radius1812, packet)
    End Sub

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

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

    Public Shared Sub ServerLog(ByVal message)
        Log.WriteLog(Now & ":" & message)
    End Sub

    Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)
        If Not packet.IsValid Then
            Console.WriteLine("Packet is not valid. Discarding.")
            Exit Sub
        End If

        Dim handler
        If TSGW = "1" Then
            handler = New RDSHandler(packet)
        Else
            handler = New CitrixHandler(packet)
        End If

        handler.ProcessRequest()
    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 Shared 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 Shared 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