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

46
server/handlers/RDSHandler.vb
View file

@ -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