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 RADAR

Public Class RDSFactor

    Public Shared LDAPDomain As String = ""
    Public Shared ADField 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 EnableSMS As Boolean = False
    Public Shared EnableEmail As Boolean = False

    Private Shared DEBUG As Boolean
    Private Shared UserAccessLog As New LogWriter
    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"
        UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt"

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

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

    Public Sub StartUpServer()
        Try
            server = New RADIUSServer(serverPort, AddressOf ProcessPacket, secrets)
            ServerLog("Starting Radius Server on Port " & serverPort & " ...OK")
        Catch
            ServerLog("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 AccessLog(packet As RADIUSPacket, message As String)
        Dim from_address = packet.EndPoint.Address.ToString
        message = "[" & packet.UserName & " " & from_address & "] " & message
        AccessLog(message)
    End Sub

    Public Shared Sub AccessLog(message As String)
        message = Now & ": DEBUG: " & message
        If DEBUG = True Then
            UserAccessLog.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 ServerLog(ByVal message)
        message = Now & ": " & 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
                ServerLog("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

                ADField = RConfig.GetKeyValue("RDSFactor", "ADField")
                If ADField.Length = 0 Then
                    ServerLog("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
                                ServerLog("ERROR:  Provider can not be empty")
                                ConfOk = False
                            End If
                        Case "1"
                            ComPort = RConfig.GetKeyValue("RDSFactor", "COMPORT")
                            If ComPort.Length = 0 Then
                                ServerLog("ERROR:  ComPort can not be empty")
                                ConfOk = False
                            End If
                            SmsC = RConfig.GetKeyValue("RDSFactor", "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

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

            If ConfOk = True Then
                ServerLog("Loading Configuration...OK")
            Else
                ServerLog("Loading Configuration...FAILED")
            End If
        Catch
            ServerLog("ERROR: Missing RDSFactor.ini from startup path or RDSFactor.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 SMSModem(ComPort)
            modem.Opens()
            modem.send(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

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

End Class