RDSFactor/server/RDSFactor.vb

Imports System.DirectoryServices
Imports System.IO
Imports System.Reflection
Imports RDSFactor.SMSModem
Imports RDSFactor.LogFile
Imports System.Security.Cryptography
Imports System.Text
Imports System
Imports System.Net.Mail
Imports System.Net.Http
Imports System.Web
Imports RADAR

Public Class RDSFactor

    Public Shared LDAPDomain As String = ""
    Public Shared ADMobileField As String = ""
    Public Shared ADMailField As String = ""
    Public Shared EnableOTP As Boolean
    Public Shared secrets As New NASAuthList

    Public Shared SessionTimeOut As Integer = 30 ' in minutes
    Public Shared LaunchTimeOut As Integer = 30 ' in seconds
    Public Shared garbageCollectionInterval As Integer = 60 * 60 * 1000 ' in millis
    Public Shared EnableSMS As Boolean = False
    Public Shared EnableEmail As Boolean = False

    Private Shared DEBUG As Boolean
    Private Shared Log As New LogWriter

    Private server As RADIUSServer
    Private serverPort As Integer = 1812
    Private userHash As New Hashtable
    Private packetHash As New Hashtable
    Private clientHash As New Hashtable

    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 = ""

    Protected Overrides Sub OnStart(ByVal args() As String)
        Log.filePath = ApplicationPath() & "\log.txt"
        Log.WriteLog("---------------------------------------------------------------------------------------------------")
        LogInfo("Starting Service")
        LogInfo("Loading Configuration...")
        loadConfiguration()
        LogInfo("Starting Radius listner ports...")
        StartUpServer()
    End Sub

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

    Public Sub StartUpServer()
        Try
            server = New RADIUSServer(serverPort, AddressOf ProcessPacket, secrets)
            LogInfo("Starting Radius Server on Port " & serverPort & " ...OK")
        Catch
            LogInfo("Starting Radius Server on Port " & serverPort & "...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 ProcessPacket(ByVal packet As RADIUSPacket)
        If Not packet.IsValid Then
            Console.WriteLine("Packet is not valid. Discarding.")
            Exit Sub
        End If

        Dim handler = New RDSHandler(packet)

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

        handler.ProcessRequest()
    End Sub

    Public Shared Sub LogDebug(packet As RADIUSPacket, message As String)
        Dim from_address = packet.EndPoint.Address.ToString
        message = "[" & packet.UserName & " " & from_address & "] " & message
        LogDebug(message)
    End Sub

    Public Shared Sub LogDebug(message As String)
        message = Now & ": DEBUG: " & message
        If DEBUG = True Then
            Log.WriteLog(message)

            ' Also write to the console if not a service
            If Environment.UserInteractive Then
                Console.WriteLine(message)
            End If
        End If
    End Sub

    Public Shared Sub LogInfo(ByVal message)
        message = Now & ": INFO: " & message
        Log.WriteLog(message)
        ' Also write to the console if not a service
        If Environment.UserInteractive Then
            Console.WriteLine(message)
        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() & "\conf\RDSFactor.ini")
            DEBUG = RConfig.GetKeyValue("RDSFactor", "Debug")

            LDAPDomain = RConfig.GetKeyValue("RDSFactor", "LDAPDomain")
            If LDAPDomain.Length = 0 Then
                LogInfo("ERROR: LDAPDomain can not be empty")
                ConfOk = False
            End If

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

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

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

                ADMobileField = RConfig.GetKeyValue("RDSFactor", "ADField")
                If ADMobileField.Length = 0 Then
                    LogInfo("ERROR:  ADField can not be empty")
                    ConfOk = False
                End If

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

            End If

            For Each client In RConfig.GetSection("clients").Keys
                Dim address = client.Name
                LogInfo("Adding Shared Secret for: " & address)
                secrets.AddSharedSecret(address, client.Value)
            Next

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

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

    Public Shared Sub SendSMS(ByVal number As String, ByVal passcode As String)

        ' test if using online sms provider or local modem
        If ModemType = 1 Then ' local modem
            Dim modem As New SMSModem(ComPort)
            modem.Opens()
            modem.send(number, passcode, SmsC)
            modem.Closes()
            modem = Nothing
        Else
            LogDebug("Sending OTP: " & passcode & " to: " & number)

            ' TODO: Use HttpUtility UrlEncode when
            ' we figure out how to add the dll!!!
            Dim url As String = Provider
            url = url.Replace("***TEXTMESSAGE***", passcode)
            url = url.Replace("***NUMBER***", number)

            Dim client As New HttpClient

            Dim response = client.GetAsync(url).Result
            Dim content = response.Content.ReadAsStringAsync().Result

            If response.IsSuccessStatusCode Then

                If Not url.IndexOf("cpsms.dk") = -1 Then
                    ' NOTE: Yes cpsms does indeed return HTTP 200 on errors!?!
                    If Not content.IndexOf("error") = -1 Then
                        Throw New SMSSendException(content)
                    End If
                End If
            Else
                Throw New SMSSendException(content)
            End If
        End If
    End Sub

    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
                LogDebug(Now & ": Mail send to: " & email)
            End If
            Return "SEND"
        Catch e As InvalidCastException

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

    Public Sub CleanupEventHandler(sender, e) Handles cleanupEvent.Elapsed
        RDSHandler.Cleanup()
    End Sub

End Class