zydronium/RDSFactor
1
0
Fork 0
mirror of https://github.com/jakobadam/RDSFactor.git synced 2025-06-02 02:28:18 +02:00
Code Issues Projects Releases Packages Wiki Activity

Use the AccessLog for logging

Browse source
This commit is contained in:
Jakob A. Dam 2015-04-09 09:42:59 +02:00 • committed by Jakob Aarøe Dam
parent 5ef3e371c3
commit 3a2dff8fcd
2 changed files with 32 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

9
CICRadarR/CICRadarR.vb
View file

@ -130,11 +130,20 @@ Public Class CICRadarR
Public Shared Sub AccessLog(ByVal message) Public Shared Sub AccessLog(ByVal message)
If DEBUG = True Then If DEBUG = True Then
UserAccessLog.WriteLog(Now & ": DEBUG: " & message) UserAccessLog.WriteLog(Now & ": DEBUG: " & message)
' Also write to the console if not a service
If Environment.UserInteractive Then
Console.WriteLine(Now & ": DEBUG: " & message)
End If
End If End If
End Sub End Sub
Public Shared Sub ServerLog(ByVal message) Public Shared Sub ServerLog(ByVal message)
Log.WriteLog(Now & ":" & message) Log.WriteLog(Now & ":" & message)
' Also write to the console if not a service
If Environment.UserInteractive Then
Console.WriteLine(Now & message)
End If
End Sub End Sub
Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket) Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)

43
CICRadarR/handlers/RDSHandler.vb
View file

@ -74,7 +74,7 @@ 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()
Console.WriteLine("ProcessAppLaunchRequest") CICRadarR.AccessLog("ProcessAppLaunchRequest")
' 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
@ -82,7 +82,7 @@ Public Class RDSHandler
Dim sessionTimestamp = sessionTimestamps(mUsername) Dim sessionTimestamp = sessionTimestamps(mUsername)
If storedSessionId = Nothing Or sessionTimestamp = Nothing Then If storedSessionId = Nothing Or sessionTimestamp = Nothing Then
Console.WriteLine("User has no session. MUST re-authenticate!") CICRadarR.AccessLog("User has no session. MUST re-authenticate!")
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
Exit Sub Exit Sub
End If End If
@ -90,7 +90,7 @@ Public Class RDSHandler
If packetSessionId = storedSessionId Then If packetSessionId = storedSessionId Then
Dim minsSinceLastActivity = DateDiff(DateInterval.Minute, sessionTimestamp, Now) Dim minsSinceLastActivity = DateDiff(DateInterval.Minute, sessionTimestamp, Now)
If minsSinceLastActivity < CICRadarR.SessionTimeOut Then If minsSinceLastActivity < CICRadarR.SessionTimeOut Then
Console.WriteLine("Opening window for: " & mUsername) CICRadarR.AccessLog("Opening window for: " & mUsername)
' Pro-long session ' Pro-long session
sessionTimestamps(storedSessionId) = Now sessionTimestamps(storedSessionId) = Now
' Open launch window ' Open launch window
@ -98,12 +98,12 @@ Public Class RDSHandler
mPacket.AcceptAccessRequest() mPacket.AcceptAccessRequest()
Exit Sub Exit Sub
Else Else
Console.WriteLine("Session timed out -- User MUST re-authenticate") CICRadarR.AccessLog("Session timed out -- User MUST re-authenticate")
userSessions.Remove(mUsername) userSessions.Remove(mUsername)
sessionTimestamps.Remove(mUsername) sessionTimestamps.Remove(mUsername)
End If End If
Else Else
Console.WriteLine("Stored session id didn't match packet session id!") CICRadarR.AccessLog("Stored session id didn't match packet session id!")
End If End If
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
@ -117,15 +117,18 @@ Public Class RDSHandler
' * valid app launch window ' * valid app launch window
' '
' The launch window is closed after this request. ' The launch window is closed after this request.
'
' TODO: Fix race-condition RD Web vs. Gateway. Don't start RDP client in RD Web
' before ensuring App Launch request was successful
Public Sub ProcessGatewayRequest() Public Sub ProcessGatewayRequest()
Console.WriteLine("Gateway Request for user: " & mUsername) CICRadarR.AccessLog("Gateway Request for user: " & mUsername)
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
Console.WriteLine("User's has no lauch window. User must re-authenticate") CICRadarR.AccessLog("User's has no launch window. User must re-authenticate")
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
Exit Sub Exit Sub
End If End If
@ -138,10 +141,10 @@ Public Class RDSHandler
Dim secondsSinceLaunch = DateDiff(DateInterval.Second, launchTimestamp, Now) Dim secondsSinceLaunch = DateDiff(DateInterval.Second, launchTimestamp, Now)
If secondsSinceLaunch < CICRadarR.LaunchTimeOut Then If secondsSinceLaunch < CICRadarR.LaunchTimeOut Then
Console.WriteLine("Allowing access through gateway for user: " & mUsername & " -- closing window") CICRadarR.AccessLog("Allowing access through gateway for user: " & mUsername & " -- closing window")
mPacket.AcceptAccessRequest(attributes) mPacket.AcceptAccessRequest(attributes)
Else Else
Console.WriteLine("Launch window has closed!") CICRadarR.AccessLog("Launch window has closed!")
End If End If
' close window ' close window
@ -156,7 +159,7 @@ Public Class RDSHandler
Exit Sub Exit Sub
End If End If
Console.WriteLine("ProcessAccessRequest") CICRadarR.AccessLog("ProcessAccessRequest")
Try Try
Dim ldapResult = Authenticate() Dim ldapResult = Authenticate()
@ -167,13 +170,13 @@ Public Class RDSHandler
Accept() Accept()
End If End If
Catch ex As Exception Catch ex As Exception
Console.WriteLine("Authentication failed. Sending reject. Error: " & ex.Message) CICRadarR.AccessLog("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()
Console.WriteLine("Accept") CICRadarR.AccessLog("Accept")
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
@ -186,7 +189,7 @@ Public Class RDSHandler
End Sub End Sub
Private Sub ProcessChallengeResponse() Private Sub ProcessChallengeResponse()
Console.WriteLine("ProcessChallengeResponse") CICRadarR.AccessLog("ProcessChallengeResponse")
' When the packet is an Challange-Response the password attr. contains the token ' When the packet is an Challange-Response the password attr. contains the token
Dim challangeCode = mPassword Dim challangeCode = mPassword
@ -203,17 +206,17 @@ Public Class RDSHandler
Private Sub TwoFactorChallenge() Private Sub TwoFactorChallenge()
Dim code = CICRadarR.GenerateCode Dim code = CICRadarR.GenerateCode
Dim sid = EncDec.Encrypt(mUsername & "_" & code, CICRadarR.encCode) 'generate unique code Dim sid = EncDec.Encrypt(mUsername & "_" & code, CICRadarR.encCode) 'generate unique code
Console.WriteLine("Access Challange Code: " & code) CICRadarR.AccessLog("Access Challange Code: " & code)
userSidTokens(mUsername) = sid userSidTokens(mUsername) = sid
tokenTimestamps(mUsername) = Now tokenTimestamps(mUsername) = Now
If mUseSMSFactor Then If mUseSMSFactor Then
Console.WriteLine("TODO: Send SMS") CICRadarR.AccessLog("TODO: Send SMS")
End If End If
If mUseEmailFactor Then If mUseEmailFactor Then
Console.WriteLine("TODO: Send Email") CICRadarR.AccessLog("TODO: Send Email")
End If End If
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
@ -231,7 +234,7 @@ Public Class RDSHandler
Dim password As String = mPacket.UserPassword Dim password As String = mPacket.UserPassword
Dim ldapDomain As String = CICRadarR.LDAPDomain Dim ldapDomain As String = CICRadarR.LDAPDomain
Console.WriteLine("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & mUsername) CICRadarR.AccessLog("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & mUsername)
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
@ -252,7 +255,7 @@ Public Class RDSHandler
Dim result = search.FindOne() Dim result = search.FindOne()
If IsDBNull(result) Then If IsDBNull(result) Then
Console.WriteLine("Failed to authenticate with Active Directory") CICRadarR.AccessLog("Failed to authenticate with Active Directory")
Throw New MissingUser Throw New MissingUser
End If End If
@ -263,7 +266,7 @@ Public Class RDSHandler
Dim mobile = result.Properties(CICRadarR.ADField)(0) Dim mobile = result.Properties(CICRadarR.ADField)(0)
mobile = Replace(mobile, "+", "") mobile = Replace(mobile, "+", "")
If mobile.Trim.Length = 0 Then If mobile.Trim.Length = 0 Then
Console.WriteLine("Unable to find correct phone number for user " & mUsername) CICRadarR.AccessLog("Unable to find correct phone number for user " & mUsername)
End If End If
Return mobile Return mobile
End Function End Function
@ -272,7 +275,7 @@ Public Class RDSHandler
Dim email = result.Properties(CICRadarR.ADMailField)(0) Dim email = result.Properties(CICRadarR.ADMailField)(0)
If InStr(email, "@") = 0 Then If InStr(email, "@") = 0 Then
Console.WriteLine("Unable to find correct email for user " & mUsername) CICRadarR.AccessLog("Unable to find correct email for user " & mUsername)
End If End If
Return email Return email
End Function End Function