zydronium/RDSFactor
1
0
Fork 0
mirror of https://github.com/jakobadam/RDSFactor.git synced 2025-07-23 10:05:55 +02:00
Code Issues Projects Releases Packages Wiki Activity

Use a info and a debug logger

Browse source
This commit is contained in:
Jakob Aarøe Dam 2015-04-29 13:36:07 +02:00
parent 03a50bc949
commit a23e249d98
2 changed files with 49 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

55
server/RDSFactor.vb
View file

@ -23,7 +23,6 @@ Public Class RDSFactor
Public Shared EnableEmail As Boolean = False Public Shared EnableEmail As Boolean = False
Private Shared DEBUG As Boolean Private Shared DEBUG As Boolean
Private Shared UserAccessLog As New LogWriter
Private Shared Log As New LogWriter Private Shared Log As New LogWriter
Private server As RADIUSServer Private server As RADIUSServer
@ -42,26 +41,24 @@ Public Class RDSFactor
Protected Overrides Sub OnStart(ByVal args() As String) Protected Overrides Sub OnStart(ByVal args() As String)
Log.filePath = ApplicationPath() & "\log.txt" Log.filePath = ApplicationPath() & "\log.txt"
UserAccessLog.filePath = ApplicationPath() & "\UserAccessLog.txt"
Log.WriteLog("---------------------------------------------------------------------------------------------------") Log.WriteLog("---------------------------------------------------------------------------------------------------")
ServerLog("Starting Service") LogInfo("Starting Service")
ServerLog("Loading Configuration...") LogInfo("Loading Configuration...")
loadConfiguration() loadConfiguration()
ServerLog("Starting Radius listner ports...") LogInfo("Starting Radius listner ports...")
StartUpServer() StartUpServer()
End Sub End Sub
Protected Overrides Sub OnStop() Protected Overrides Sub OnStop()
ServerLog("Stopping Radius listner ports...") LogInfo("Stopping Radius listner ports...")
End Sub End Sub
Public Sub StartUpServer() Public Sub StartUpServer()
Try Try
server = New RADIUSServer(serverPort, AddressOf ProcessPacket, secrets) server = New RADIUSServer(serverPort, AddressOf ProcessPacket, secrets)
ServerLog("Starting Radius Server on Port " & serverPort & " ...OK") LogInfo("Starting Radius Server on Port " & serverPort & " ...OK")
Catch Catch
ServerLog("Starting Radius Server on Port " & serverPort & "...FAILED") LogInfo("Starting Radius Server on Port " & serverPort & "...FAILED")
End Try End Try
End Sub End Sub
@ -84,16 +81,16 @@ Public Class RDSFactor
handler.ProcessRequest() handler.ProcessRequest()
End Sub 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 Dim from_address = packet.EndPoint.Address.ToString
message = "[" & packet.UserName & " " & from_address & "] " & message message = "[" & packet.UserName & " " & from_address & "] " & message
AccessLog(message) LogDebug(message)
End Sub End Sub
Public Shared Sub AccessLog(message As String) Public Shared Sub LogDebug(message As String)
message = Now & ": DEBUG: " & message message = Now & ": DEBUG: " & message
If DEBUG = True Then If DEBUG = True Then
UserAccessLog.WriteLog(message) Log.WriteLog(message)
' Also write to the console if not a service ' Also write to the console if not a service
If Environment.UserInteractive Then If Environment.UserInteractive Then
@ -102,8 +99,8 @@ Public Class RDSFactor
End If End If
End Sub End Sub
Public Shared Sub ServerLog(ByVal message) Public Shared Sub LogInfo(ByVal message)
message = Now & ": " & message message = Now & ": INFO: " & message
Log.WriteLog(message) Log.WriteLog(message)
' Also write to the console if not a service ' Also write to the console if not a service
If Environment.UserInteractive Then If Environment.UserInteractive Then
@ -136,7 +133,7 @@ Public Class RDSFactor
LDAPDomain = RConfig.GetKeyValue("RDSFactor", "LDAPDomain") LDAPDomain = RConfig.GetKeyValue("RDSFactor", "LDAPDomain")
If LDAPDomain.Length = 0 Then If LDAPDomain.Length = 0 Then
ServerLog("ERROR: LDAPDomain can not be empty") LogInfo("ERROR: LDAPDomain can not be empty")
ConfOk = False ConfOk = False
End If End If
@ -154,7 +151,7 @@ Public Class RDSFactor
ADField = RConfig.GetKeyValue("RDSFactor", "ADField") ADField = RConfig.GetKeyValue("RDSFactor", "ADField")
If ADField.Length = 0 Then If ADField.Length = 0 Then
ServerLog("ERROR: ADField can not be empty") LogInfo("ERROR: ADField can not be empty")
ConfOk = False ConfOk = False
End If End If
@ -165,22 +162,22 @@ Public Class RDSFactor
Case "0" Case "0"
Provider = RConfig.GetKeyValue("RDSFactor", "Provider") Provider = RConfig.GetKeyValue("RDSFactor", "Provider")
If Provider.Length = 0 Then If Provider.Length = 0 Then
ServerLog("ERROR: Provider can not be empty") LogInfo("ERROR: Provider can not be empty")
ConfOk = False ConfOk = False
End If End If
Case "1" Case "1"
ComPort = RConfig.GetKeyValue("RDSFactor", "COMPORT") ComPort = RConfig.GetKeyValue("RDSFactor", "COMPORT")
If ComPort.Length = 0 Then If ComPort.Length = 0 Then
ServerLog("ERROR: ComPort can not be empty") LogInfo("ERROR: ComPort can not be empty")
ConfOk = False ConfOk = False
End If End If
SmsC = RConfig.GetKeyValue("RDSFactor", "SMSC") SmsC = RConfig.GetKeyValue("RDSFactor", "SMSC")
If SmsC.Length = 0 Then 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 ConfOk = False
End If End If
Case Else 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 ConfOk = False
End Select End Select
End If End If
@ -189,18 +186,18 @@ Public Class RDSFactor
For Each client In RConfig.GetSection("clients").Keys For Each client In RConfig.GetSection("clients").Keys
Dim address = client.Name Dim address = client.Name
ServerLog("Adding Shared Secret for: " & address) LogInfo("Adding Shared Secret for: " & address)
secrets.AddSharedSecret(address, client.Value) secrets.AddSharedSecret(address, client.Value)
Next Next
If ConfOk = True Then If ConfOk = True Then
ServerLog("Loading Configuration...OK") LogInfo("Loading Configuration...OK")
Else Else
ServerLog("Loading Configuration...FAILED") LogInfo("Loading Configuration...FAILED")
End If End If
Catch Catch
ServerLog("ERROR: Missing RDSFactor.ini from startup path or RDSFactor.ini contains invalid configuration") LogInfo("ERROR: Missing RDSFactor.ini from startup path or RDSFactor.ini contains invalid configuration")
ServerLog("Loading Configuration...FAILED") LogInfo("Loading Configuration...FAILED")
End End
End Try End Try
End Sub End Sub
@ -271,14 +268,14 @@ Public Class RDSFactor
Try Try
smtp.Send(mail) smtp.Send(mail)
If DEBUG = True Then If DEBUG = True Then
AccessLog(Now & ": Mail send to: " & email) LogDebug(Now & ": Mail send to: " & email)
End If End If
Return "SEND" Return "SEND"
Catch e As InvalidCastException Catch e As InvalidCastException
If DEBUG = True Then If DEBUG = True Then
AccessLog(Now & " : Debug: " & e.Message) LogDebug(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 & " : 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 End If
Return "FAILED" Return "FAILED"
End Try End Try

46
server/handlers/RDSHandler.vb
View file

@ -76,26 +76,26 @@ Public Class RDSHandler
' NOTE: Requests contain the session GUID in the password attribute ' NOTE: Requests contain the session GUID in the password attribute
' of the packet. ' of the packet.
Public Sub ProcessAppLaunchRequest() Public Sub ProcessAppLaunchRequest()
RDSFactor.AccessLog(mPacket, "AppLaunchRequest") RDSFactor.LogDebug(mPacket, "AppLaunchRequest")
' When the packet is an AppLaunchRequest the password attribute contains the session id! ' When the packet is an AppLaunchRequest the password attribute contains the session id!
Dim packetSessionId = mPassword Dim packetSessionId = mPassword
Dim storedSessionId = userSessions(mUsername) Dim storedSessionId = userSessions(mUsername)
If storedSessionId = Nothing Then 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() mPacket.RejectAccessRequest()
Exit Sub Exit Sub
End If End If
If Not storedSessionId = packetSessionId Then 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() mPacket.RejectAccessRequest()
Exit Sub Exit Sub
End If End If
If HasValidSession(mUsername) Then If HasValidSession(mUsername) Then
RDSFactor.AccessLog(mPacket, "Opening window") RDSFactor.LogDebug(mPacket, "Opening window")
' Pro-long user session ' Pro-long user session
sessionTimestamps(mUsername) = Now sessionTimestamps(mUsername) = Now
' Open gateway connection window ' Open gateway connection window
@ -103,7 +103,7 @@ Public Class RDSHandler
mPacket.AcceptAccessRequest() mPacket.AcceptAccessRequest()
Exit Sub Exit Sub
Else Else
RDSFactor.AccessLog(mPacket, "Session timed out -- User MUST re-authenticate") RDSFactor.LogDebug(mPacket, "Session timed out -- User MUST re-authenticate")
userSessions.Remove(mUsername) userSessions.Remove(mUsername)
sessionTimestamps.Remove(mUsername) sessionTimestamps.Remove(mUsername)
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
@ -142,14 +142,14 @@ Public Class RDSHandler
' '
' The launch window is closed after this request. ' The launch window is closed after this request.
Public Sub ProcessGatewayRequest() Public Sub ProcessGatewayRequest()
RDSFactor.AccessLog(mPacket, "Gateway Request") RDSFactor.LogDebug(mPacket, "Gateway Request")
Dim sessionId = userSessions(mUsername) Dim sessionId = userSessions(mUsername)
Dim launchTimestamp = userLaunchTimestamps(mUsername) Dim launchTimestamp = userLaunchTimestamps(mUsername)
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
If sessionId = Nothing Or launchTimestamp = Nothing Then 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() mPacket.RejectAccessRequest()
Exit Sub Exit Sub
End If End If
@ -161,14 +161,14 @@ Public Class RDSHandler
End If End If
If HasValidLaunchWindow(mUsername) Then If HasValidLaunchWindow(mUsername) Then
RDSFactor.AccessLog(mPacket, "Opening gateway launch window") RDSFactor.LogDebug(mPacket, "Opening gateway launch window")
mPacket.AcceptAccessRequest(attributes) mPacket.AcceptAccessRequest(attributes)
Else Else
RDSFactor.AccessLog(mPacket, "Gateway launch window has timed out!") RDSFactor.LogDebug(mPacket, "Gateway launch window has timed out!")
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
End If End If
RDSFactor.AccessLog(mPacket, "Removing gateway launch window") RDSFactor.LogDebug(mPacket, "Removing gateway launch window")
userLaunchTimestamps.Remove(mUsername) userLaunchTimestamps.Remove(mUsername)
End Sub End Sub
@ -180,7 +180,7 @@ Public Class RDSHandler
Exit Sub Exit Sub
End If End If
RDSFactor.AccessLog(mPacket, "AccessRequest") RDSFactor.LogDebug(mPacket, "AccessRequest")
Try Try
Dim ldapResult = Authenticate() Dim ldapResult = Authenticate()
@ -191,13 +191,13 @@ Public Class RDSHandler
Accept() Accept()
End If End If
Catch ex As Exception 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() mPacket.RejectAccessRequest()
End Try End Try
End Sub End Sub
Private Sub Accept() Private Sub Accept()
RDSFactor.AccessLog(mPacket, "AcceptAccessRequest") RDSFactor.LogDebug(mPacket, "AcceptAccessRequest")
Dim sGUID As String = System.Guid.NewGuid.ToString() Dim sGUID As String = System.Guid.NewGuid.ToString()
userSessions(mUsername) = sGUID userSessions(mUsername) = sGUID
sessionTimestamps(mUsername) = Now sessionTimestamps(mUsername) = Now
@ -220,12 +220,12 @@ Public Class RDSHandler
Dim localEncryptedResult = encryptedChallangeResults(mUsername) Dim localEncryptedResult = encryptedChallangeResults(mUsername)
If localEncryptedResult = userEncryptedResult Then If localEncryptedResult = userEncryptedResult Then
RDSFactor.AccessLog(mPacket, "ChallengeResponse Success") RDSFactor.LogDebug(mPacket, "ChallengeResponse Success")
encryptedChallangeResults.Remove(mUsername) encryptedChallangeResults.Remove(mUsername)
authTokens.Remove(mUsername) authTokens.Remove(mUsername)
Accept() Accept()
Else Else
RDSFactor.AccessLog(mPacket, "Wrong challange code!") RDSFactor.LogDebug(mPacket, "Wrong challange code!")
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
End If End If
End Sub End Sub
@ -236,7 +236,7 @@ Public Class RDSHandler
Dim clientIP = mPacket.EndPoint.Address.ToString Dim clientIP = mPacket.EndPoint.Address.ToString
Dim sharedSecret = RDSFactor.secrets(clientIP) Dim sharedSecret = RDSFactor.secrets(clientIP)
RDSFactor.AccessLog(mPacket, "Access Challange Code: " & challangeCode) RDSFactor.LogDebug(mPacket, "Access Challange Code: " & challangeCode)
If sharedSecret = Nothing Then If sharedSecret = Nothing Then
Throw New Exception("No shared secret for client:" & clientIP) Throw New Exception("No shared secret for client:" & clientIP)
@ -247,11 +247,11 @@ Public Class RDSHandler
encryptedChallangeResults(mUsername) = encryptedChallangeResult encryptedChallangeResults(mUsername) = encryptedChallangeResult
If mUseSMSFactor Then If mUseSMSFactor Then
RDSFactor.AccessLog(mPacket, "TODO: Send SMS") RDSFactor.LogDebug(mPacket, "TODO: Send SMS")
End If End If
If mUseEmailFactor Then If mUseEmailFactor Then
RDSFactor.AccessLog(mPacket, "TODO: Send Email") RDSFactor.LogDebug(mPacket, "TODO: Send Email")
End If End If
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
@ -269,7 +269,7 @@ Public Class RDSHandler
Dim password As String = mPacket.UserPassword Dim password As String = mPacket.UserPassword
Dim ldapDomain As String = RDSFactor.LDAPDomain 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 dirEntry As New DirectoryEntry("LDAP://" & ldapDomain, mUsername, password)
Dim obj As Object = dirEntry.NativeObject Dim obj As Object = dirEntry.NativeObject
@ -290,7 +290,7 @@ Public Class RDSHandler
Dim result = search.FindOne() Dim result = search.FindOne()
If IsDBNull(result) Then 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 Throw New MissingUser
End If End If
@ -301,7 +301,7 @@ Public Class RDSHandler
Dim mobile = result.Properties(RDSFactor.ADField)(0) Dim mobile = result.Properties(RDSFactor.ADField)(0)
mobile = Replace(mobile, "+", "") mobile = Replace(mobile, "+", "")
If mobile.Trim.Length = 0 Then 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 End If
Return mobile Return mobile
End Function End Function
@ -310,13 +310,13 @@ Public Class RDSHandler
Dim email = result.Properties(RDSFactor.ADMailField)(0) Dim email = result.Properties(RDSFactor.ADMailField)(0)
If InStr(email, "@") = 0 Then 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 End If
Return email Return email
End Function End Function
Public Shared Sub Cleanup() Public Shared Sub Cleanup()
RDSFactor.AccessLog("TimerCleanUp") RDSFactor.LogDebug("TimerCleanUp")
Dim users = New ArrayList(userSessions.Keys) Dim users = New ArrayList(userSessions.Keys)
For Each username In users For Each username In users