diff --git a/server/RDSFactor.vb b/server/RDSFactor.vb index 706a1b0..bee8d08 100644 --- a/server/RDSFactor.vb +++ b/server/RDSFactor.vb @@ -23,7 +23,6 @@ Public Class RDSFactor 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 @@ -42,26 +41,24 @@ Public Class RDSFactor 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...") + LogInfo("Starting Service") + LogInfo("Loading Configuration...") loadConfiguration() - ServerLog("Starting Radius listner ports...") + LogInfo("Starting Radius listner ports...") StartUpServer() End Sub Protected Overrides Sub OnStop() - ServerLog("Stopping Radius listner ports...") + LogInfo("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") + LogInfo("Starting Radius Server on Port " & serverPort & " ...OK") Catch - ServerLog("Starting Radius Server on Port " & serverPort & "...FAILED") + LogInfo("Starting Radius Server on Port " & serverPort & "...FAILED") End Try End Sub @@ -84,16 +81,16 @@ Public Class RDSFactor handler.ProcessRequest() End Sub - Public Shared Sub AccessLog(packet As RADIUSPacket, message As String) + Public Shared Sub LogDebug(packet As RADIUSPacket, message As String) Dim from_address = packet.EndPoint.Address.ToString message = "[" & packet.UserName & " " & from_address & "] " & message - AccessLog(message) + LogDebug(message) End Sub - Public Shared Sub AccessLog(message As String) + Public Shared Sub LogDebug(message As String) message = Now & ": DEBUG: " & message If DEBUG = True Then - UserAccessLog.WriteLog(message) + Log.WriteLog(message) ' Also write to the console if not a service If Environment.UserInteractive Then @@ -102,8 +99,8 @@ Public Class RDSFactor End If End Sub - Public Shared Sub ServerLog(ByVal message) - message = Now & ": " & message + 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 @@ -136,7 +133,7 @@ Public Class RDSFactor LDAPDomain = RConfig.GetKeyValue("RDSFactor", "LDAPDomain") If LDAPDomain.Length = 0 Then - ServerLog("ERROR: LDAPDomain can not be empty") + LogInfo("ERROR: LDAPDomain can not be empty") ConfOk = False End If @@ -154,7 +151,7 @@ Public Class RDSFactor ADField = RConfig.GetKeyValue("RDSFactor", "ADField") If ADField.Length = 0 Then - ServerLog("ERROR: ADField can not be empty") + LogInfo("ERROR: ADField can not be empty") ConfOk = False End If @@ -165,22 +162,22 @@ Public Class RDSFactor Case "0" Provider = RConfig.GetKeyValue("RDSFactor", "Provider") If Provider.Length = 0 Then - ServerLog("ERROR: Provider can not be empty") + LogInfo("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") + LogInfo("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") + LogInfo("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") + LogInfo("ERROR: USELOCALMODEM contain invalid configuration. Correct value are 1 or 0") ConfOk = False End Select End If @@ -189,18 +186,18 @@ Public Class RDSFactor For Each client In RConfig.GetSection("clients").Keys Dim address = client.Name - ServerLog("Adding Shared Secret for: " & address) + LogInfo("Adding Shared Secret for: " & address) secrets.AddSharedSecret(address, client.Value) Next If ConfOk = True Then - ServerLog("Loading Configuration...OK") + LogInfo("Loading Configuration...OK") Else - ServerLog("Loading Configuration...FAILED") + LogInfo("Loading Configuration...FAILED") End If Catch - ServerLog("ERROR: Missing RDSFactor.ini from startup path or RDSFactor.ini contains invalid configuration") - ServerLog("Loading Configuration...FAILED") + LogInfo("ERROR: Missing RDSFactor.ini from startup path or RDSFactor.ini contains invalid configuration") + LogInfo("Loading Configuration...FAILED") End End Try End Sub @@ -271,14 +268,14 @@ Public Class RDSFactor Try smtp.Send(mail) If DEBUG = True Then - AccessLog(Now & ": Mail send to: " & email) + LogDebug(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") + 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 diff --git a/server/handlers/RDSHandler.vb b/server/handlers/RDSHandler.vb index 971e854..1e1c06b 100644 --- a/server/handlers/RDSHandler.vb +++ b/server/handlers/RDSHandler.vb @@ -76,26 +76,26 @@ Public Class RDSHandler ' NOTE: Requests contain the session GUID in the password attribute ' of the packet. Public Sub ProcessAppLaunchRequest() - RDSFactor.AccessLog(mPacket, "AppLaunchRequest") + RDSFactor.LogDebug(mPacket, "AppLaunchRequest") ' When the packet is an AppLaunchRequest the password attribute contains the session id! Dim packetSessionId = mPassword Dim storedSessionId = userSessions(mUsername) If storedSessionId = Nothing Then - RDSFactor.AccessLog(mPacket, "User has no session. MUST re-authenticate!") + RDSFactor.LogDebug(mPacket, "User has no session. MUST re-authenticate!") mPacket.RejectAccessRequest() Exit Sub End If If Not storedSessionId = packetSessionId Then - RDSFactor.AccessLog(mPacket, "Stored session id didn't match packet session id!") + RDSFactor.LogDebug(mPacket, "Stored session id didn't match packet session id!") mPacket.RejectAccessRequest() Exit Sub End If If HasValidSession(mUsername) Then - RDSFactor.AccessLog(mPacket, "Opening window") + RDSFactor.LogDebug(mPacket, "Opening window") ' Pro-long user session sessionTimestamps(mUsername) = Now ' Open gateway connection window @@ -103,7 +103,7 @@ Public Class RDSHandler mPacket.AcceptAccessRequest() Exit Sub Else - RDSFactor.AccessLog(mPacket, "Session timed out -- User MUST re-authenticate") + RDSFactor.LogDebug(mPacket, "Session timed out -- User MUST re-authenticate") userSessions.Remove(mUsername) sessionTimestamps.Remove(mUsername) mPacket.RejectAccessRequest() @@ -142,14 +142,14 @@ Public Class RDSHandler ' ' The launch window is closed after this request. Public Sub ProcessGatewayRequest() - RDSFactor.AccessLog(mPacket, "Gateway Request") + RDSFactor.LogDebug(mPacket, "Gateway Request") Dim sessionId = userSessions(mUsername) Dim launchTimestamp = userLaunchTimestamps(mUsername) Dim attributes As New RADIUSAttributes If sessionId = Nothing Or launchTimestamp = Nothing Then - RDSFactor.AccessLog(mPacket, "User's has no launch window. User must re-authenticate") + RDSFactor.LogDebug(mPacket, "User's has no launch window. User must re-authenticate") mPacket.RejectAccessRequest() Exit Sub End If @@ -161,14 +161,14 @@ Public Class RDSHandler End If If HasValidLaunchWindow(mUsername) Then - RDSFactor.AccessLog(mPacket, "Opening gateway launch window") + RDSFactor.LogDebug(mPacket, "Opening gateway launch window") mPacket.AcceptAccessRequest(attributes) Else - RDSFactor.AccessLog(mPacket, "Gateway launch window has timed out!") + RDSFactor.LogDebug(mPacket, "Gateway launch window has timed out!") mPacket.RejectAccessRequest() End If - RDSFactor.AccessLog(mPacket, "Removing gateway launch window") + RDSFactor.LogDebug(mPacket, "Removing gateway launch window") userLaunchTimestamps.Remove(mUsername) End Sub @@ -180,7 +180,7 @@ Public Class RDSHandler Exit Sub End If - RDSFactor.AccessLog(mPacket, "AccessRequest") + RDSFactor.LogDebug(mPacket, "AccessRequest") Try Dim ldapResult = Authenticate() @@ -191,13 +191,13 @@ Public Class RDSHandler Accept() End If Catch ex As Exception - RDSFactor.AccessLog(mPacket, "Authentication failed. Sending reject. Error: " & ex.Message) + RDSFactor.LogDebug(mPacket, "Authentication failed. Sending reject. Error: " & ex.Message) mPacket.RejectAccessRequest() End Try End Sub Private Sub Accept() - RDSFactor.AccessLog(mPacket, "AcceptAccessRequest") + RDSFactor.LogDebug(mPacket, "AcceptAccessRequest") Dim sGUID As String = System.Guid.NewGuid.ToString() userSessions(mUsername) = sGUID sessionTimestamps(mUsername) = Now @@ -220,12 +220,12 @@ Public Class RDSHandler Dim localEncryptedResult = encryptedChallangeResults(mUsername) If localEncryptedResult = userEncryptedResult Then - RDSFactor.AccessLog(mPacket, "ChallengeResponse Success") + RDSFactor.LogDebug(mPacket, "ChallengeResponse Success") encryptedChallangeResults.Remove(mUsername) authTokens.Remove(mUsername) Accept() Else - RDSFactor.AccessLog(mPacket, "Wrong challange code!") + RDSFactor.LogDebug(mPacket, "Wrong challange code!") mPacket.RejectAccessRequest() End If End Sub @@ -236,7 +236,7 @@ Public Class RDSHandler Dim clientIP = mPacket.EndPoint.Address.ToString Dim sharedSecret = RDSFactor.secrets(clientIP) - RDSFactor.AccessLog(mPacket, "Access Challange Code: " & challangeCode) + RDSFactor.LogDebug(mPacket, "Access Challange Code: " & challangeCode) If sharedSecret = Nothing Then Throw New Exception("No shared secret for client:" & clientIP) @@ -247,11 +247,11 @@ Public Class RDSHandler encryptedChallangeResults(mUsername) = encryptedChallangeResult If mUseSMSFactor Then - RDSFactor.AccessLog(mPacket, "TODO: Send SMS") + RDSFactor.LogDebug(mPacket, "TODO: Send SMS") End If If mUseEmailFactor Then - RDSFactor.AccessLog(mPacket, "TODO: Send Email") + RDSFactor.LogDebug(mPacket, "TODO: Send Email") End If Dim attributes As New RADIUSAttributes @@ -269,7 +269,7 @@ Public Class RDSHandler Dim password As String = mPacket.UserPassword Dim ldapDomain As String = RDSFactor.LDAPDomain - RDSFactor.AccessLog(mPacket, "Authenticating with LDAP: " & "LDAP://" & ldapDomain) + RDSFactor.LogDebug(mPacket, "Authenticating with LDAP: " & "LDAP://" & ldapDomain) Dim dirEntry As New DirectoryEntry("LDAP://" & ldapDomain, mUsername, password) Dim obj As Object = dirEntry.NativeObject @@ -290,7 +290,7 @@ Public Class RDSHandler Dim result = search.FindOne() If IsDBNull(result) Then - RDSFactor.AccessLog(mPacket, "Failed to authenticate with Active Directory") + RDSFactor.LogDebug(mPacket, "Failed to authenticate with Active Directory") Throw New MissingUser End If @@ -301,7 +301,7 @@ Public Class RDSHandler Dim mobile = result.Properties(RDSFactor.ADField)(0) mobile = Replace(mobile, "+", "") If mobile.Trim.Length = 0 Then - RDSFactor.AccessLog(mPacket, "Unable to find correct phone number for user " & mUsername) + RDSFactor.LogDebug(mPacket, "Unable to find correct phone number for user " & mUsername) End If Return mobile End Function @@ -310,13 +310,13 @@ Public Class RDSHandler Dim email = result.Properties(RDSFactor.ADMailField)(0) If InStr(email, "@") = 0 Then - RDSFactor.AccessLog(mPacket, "Unable to find correct email for user " & mUsername) + RDSFactor.LogDebug(mPacket, "Unable to find correct email for user " & mUsername) End If Return email End Function Public Shared Sub Cleanup() - RDSFactor.AccessLog("TimerCleanUp") + RDSFactor.LogDebug("TimerCleanUp") Dim users = New ArrayList(userSessions.Keys) For Each username In users