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

Better log output

Browse source
This commit is contained in:
Jakob A. Dam 2015-04-16 08:56:46 +02:00
parent 031a9948d6
commit 59885e7c5a
3 changed files with 53 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

12
RDSFactor/RDSFactor.vb
View file

@ -129,13 +129,19 @@ Public Class RDSFactor
ProcessPacket(radius1645, packet) ProcessPacket(radius1645, packet)
End Sub End Sub
Public Shared Sub AccessLog(ByVal message) Public Shared Sub AccessLog(packet As RADIUSPacket, message As String)
Dim from_address = packet.EndPoint.Address.ToString
Dim log_message = Now & ": DEBUG: [" & packet.UserName & " " & from_address & "] " & message
AccessLog(log_message)
End Sub
Public Shared Sub AccessLog(message As String)
If DEBUG = True Then If DEBUG = True Then
UserAccessLog.WriteLog(Now & ": DEBUG: " & message) UserAccessLog.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
Console.WriteLine(Now & ": DEBUG: " & message) Console.WriteLine(message)
End If End If
End If End If
End Sub End Sub

44
RDSFactor/handlers/CitrixHandler.vb
View file

@ -7,6 +7,8 @@ Imports RADAR
' Look in RDSHandler how this should be refactored. ' Look in RDSHandler how this should be refactored.
Public Class CitrixHandler Public Class CitrixHandler
Private mPacket As RADIUSPacket
Public Sub New(packet As RADIUSPacket) Public Sub New(packet As RADIUSPacket)
End Sub End Sub
@ -17,7 +19,7 @@ Public Class CitrixHandler
' and drop other requests silently ... ' and drop other requests silently ...
If packet.Code <> RadiusPacketCode.AccessRequest Then If packet.Code <> RadiusPacketCode.AccessRequest Then
RDSFactor.AccessLog("Not a valid radius packet.. Drop!") RDSFactor.AccessLog(mPacket, "Not a valid radius packet.. Drop!")
Exit Sub Exit Sub
End If End If
@ -36,11 +38,11 @@ Public Class CitrixHandler
' will return Nothing. ' will return Nothing.
If username Is Nothing Then If username Is Nothing Then
' Technically, this case is against RFC, so ... drop. ' Technically, this case is against RFC, so ... drop.
RDSFactor.AccessLog("Not a valid radius packet.. No username pressent.. Drop!") RDSFactor.AccessLog(mPacket, "Not a valid radius packet.. No username pressent.. Drop!")
Exit Sub Exit Sub
End If End If
RDSFactor.AccessLog("Processing packet for user: " & username.ToString) RDSFactor.AccessLog(mPacket, "Processing packet for user: " & username.ToString)
'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then 'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then
' Exit Sub ' Exit Sub
@ -49,16 +51,16 @@ Public Class CitrixHandler
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State) Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
RDSFactor.AccessLog("Packet contains a state attribute? State=" & existState.ToString) RDSFactor.AccessLog(mPacket, "Packet contains a state attribute? State=" & existState.ToString)
If existState = True Then ' Ok we have at packet with the State attribute set. Check if we can identify the authtentication packet. If existState = True Then ' Ok we have at packet with the State attribute set. Check if we can identify the authtentication packet.
Dim state As String = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).ToString Dim state As String = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).ToString
RDSFactor.AccessLog("Packet contains a state attribute State=" & state) RDSFactor.AccessLog(mPacket, "Packet contains a state attribute State=" & state)
Dim UserDomain As String = "" Dim UserDomain As String = ""
'lets see if user login using upd or UPN name 'lets see if user login using upd or UPN name
Dim sUserName As String = username.ToString Dim sUserName As String = username.ToString
Dim sPassword As String = packet.UserPassword Dim sPassword As String = packet.UserPassword
RDSFactor.AccessLog("SMSToken supplied by user: " & sUserName) RDSFactor.AccessLog(mPacket, "SMSToken supplied by user: " & sUserName)
sid = "" sid = ""
If InStr(sUserName, "@") > 0 Then 'UPN If InStr(sUserName, "@") > 0 Then 'UPN
@ -69,7 +71,7 @@ Public Class CitrixHandler
End If End If
sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, RDSFactor.encCode) sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, RDSFactor.encCode)
RDSFactor.AccessLog("Checking for userHash " & sid) RDSFactor.AccessLog(mPacket, "Checking for userHash " & sid)
If sid = state Then If sid = state Then
packet.AcceptAccessRequest() packet.AcceptAccessRequest()
Else Else
@ -100,7 +102,7 @@ Public Class CitrixHandler
UserDomain = RDSFactor.NetBiosDomain & "\" & sUserName UserDomain = RDSFactor.NetBiosDomain & "\" & sUserName
End If End If
RDSFactor.AccessLog("User " & UserDomain & " is trying to log in ...") RDSFactor.AccessLog(mPacket, "User " & UserDomain & " is trying to log in ...")
@ -128,7 +130,7 @@ Public Class CitrixHandler
End If End If
' Time to find out if user entered the correct username and pasword ' Time to find out if user entered the correct username and pasword
RDSFactor.AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & RDSFactor.LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword) RDSFactor.AccessLog(mPacket, "Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & RDSFactor.LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
Dim result As SearchResult = search.FindOne() Dim result As SearchResult = search.FindOne()
'Get the setting form AD. Yes we uses the field primaryTelexNumber, for who the f... still users telex. (I bet half the people reading this code don't even know what a telex is!) 'Get the setting form AD. Yes we uses the field primaryTelexNumber, for who the f... still users telex. (I bet half the people reading this code don't even know what a telex is!)
@ -147,12 +149,12 @@ Public Class CitrixHandler
If UserEmail.Trim.Length = 0 Or InStr(UserEmail, "@") = 0 Then If UserEmail.Trim.Length = 0 Or InStr(UserEmail, "@") = 0 Then
success = False success = False
RDSFactor.AccessLog("Unable to find correct email for user " & UserDomain) RDSFactor.AccessLog(mPacket, "Unable to find correct email for user " & UserDomain)
Else Else
success = True success = True
End If End If
Catch Catch
RDSFactor.AccessLog("Unable to find correct email for user " & UserDomain) RDSFactor.AccessLog(mPacket, "Unable to find correct email for user " & UserDomain)
success = False success = False
End Try End Try
End If End If
@ -162,12 +164,12 @@ Public Class CitrixHandler
mobile = Replace(mobile, "+", "") mobile = Replace(mobile, "+", "")
If mobile.Trim.Length = 0 Then If mobile.Trim.Length = 0 Then
success = False success = False
RDSFactor.AccessLog("Unable to find correct phone number for user " & UserDomain) RDSFactor.AccessLog(mPacket, "Unable to find correct phone number for user " & UserDomain)
Else Else
success = True success = True
End If End If
Catch Catch
RDSFactor.AccessLog("Unable to find correct phone number for user " & UserDomain) RDSFactor.AccessLog(mPacket, "Unable to find correct phone number for user " & UserDomain)
success = False success = False
End Try End Try
@ -183,12 +185,12 @@ Public Class CitrixHandler
'If userHash.ContainsKey(sid) Then 'If userHash.ContainsKey(sid) Then
' userHash(sid) = sPassword ' userHash(sid) = sPassword
' If DEBUG = True Then ' If DEBUG = True Then
' CICRadarR.AccessLog("Updating userHash " & sid) ' CICRadarR.AccessLog(mPacket, "Updating userHash " & sid)
' End If ' End If
'Else 'Else
' userHash.Add(sid, sPassword) ' userHash.Add(sid, sPassword)
' If DEBUG = True Then ' If DEBUG = True Then
' CICRadarR.AccessLog("Adding userHash " & sid) ' CICRadarR.AccessLog(mPacket, "Adding userHash " & sid)
' End If ' End If
'End If 'End If
' new code stored in AD now send it to the users phone ' new code stored in AD now send it to the users phone
@ -199,7 +201,7 @@ Public Class CitrixHandler
success = False success = False
End If End If
Catch Catch
RDSFactor.AccessLog("Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & RDSFactor.LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword) RDSFactor.AccessLog(mPacket, "Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & RDSFactor.LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
success = False success = False
End Try End Try
@ -207,7 +209,7 @@ Public Class CitrixHandler
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
If success Then ' Yay! Someone guess the password ... If success Then ' Yay! Someone guess the password ...
RDSFactor.AccessLog("User " & UserDomain & " authenticated agains Active Directory") RDSFactor.AccessLog(mPacket, "User " & UserDomain & " authenticated agains Active Directory")
If RDSFactor.EnableOTP = True Then If RDSFactor.EnableOTP = True Then
Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token") Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
attributes.Add(attr) attributes.Add(attr)
@ -220,21 +222,21 @@ Public Class CitrixHandler
packet.EndPoint), _ packet.EndPoint), _
packet.Authenticator) packet.Authenticator)
If RDSFactor.EnableSMS = True Then If RDSFactor.EnableSMS = True Then
RDSFactor.AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile) RDSFactor.AccessLog(mPacket, "Sending access token: " & smsCode & " to phonenumber " & mobile)
Call RDSFactor.SendSMS(mobile, smsCode) Call RDSFactor.SendSMS(mobile, smsCode)
End If End If
If RDSFactor.EnableEmail = True Then If RDSFactor.EnableEmail = True Then
RDSFactor.AccessLog("Sending access token: " & smsCode & " to email " & UserEmail) RDSFactor.AccessLog(mPacket, "Sending access token: " & smsCode & " to email " & UserEmail)
Call RDSFactor.SendEmail(UserEmail, smsCode) Call RDSFactor.SendEmail(UserEmail, smsCode)
End If End If
Else Else
RDSFactor.AccessLog("One time Password not enabled, so we let the user in") RDSFactor.AccessLog(mPacket, "One time Password not enabled, so we let the user in")
packet.AcceptAccessRequest() packet.AcceptAccessRequest()
End If End If
' packetHash.Remove(username.GetString & "_" & pass.GetString) ' packetHash.Remove(username.GetString & "_" & pass.GetString)
Else ' Wrong username / password ... Else ' Wrong username / password ...
RDSFactor.AccessLog("User " & UserDomain & " failed to authenticate against Active Directory") RDSFactor.AccessLog(mPacket, "User " & UserDomain & " failed to authenticate against Active Directory")
Dim pk As New RADIUSPacket(RadiusPacketCode.AccessReject, packet.Identifier, Nothing, packet.EndPoint) Dim pk As New RADIUSPacket(RadiusPacketCode.AccessReject, packet.Identifier, Nothing, packet.EndPoint)
server.SendAsResponse(pk, packet.Authenticator) server.SendAsResponse(pk, packet.Authenticator)
' FYI ... if no additional attributes need to be added ' FYI ... if no additional attributes need to be added

41
RDSFactor/handlers/RDSHandler.vb
View file

@ -75,7 +75,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()
RDSFactor.AccessLog("ProcessAppLaunchRequest") RDSFactor.AccessLog(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
@ -83,7 +83,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
RDSFactor.AccessLog("User has no session. MUST re-authenticate!") RDSFactor.AccessLog(mPacket, "User has no session. MUST re-authenticate!")
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
Exit Sub Exit Sub
End If End If
@ -91,7 +91,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 < RDSFactor.SessionTimeOut Then If minsSinceLastActivity < RDSFactor.SessionTimeOut Then
RDSFactor.AccessLog("Opening window for: " & mUsername) RDSFactor.AccessLog(mPacket, "Opening window")
' Pro-long session ' Pro-long session
sessionTimestamps(storedSessionId) = Now sessionTimestamps(storedSessionId) = Now
' Open launch window ' Open launch window
@ -99,12 +99,12 @@ Public Class RDSHandler
mPacket.AcceptAccessRequest() mPacket.AcceptAccessRequest()
Exit Sub Exit Sub
Else Else
RDSFactor.AccessLog("Session timed out -- User MUST re-authenticate") RDSFactor.AccessLog(mPacket, "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
RDSFactor.AccessLog("Stored session id didn't match packet session id!") RDSFactor.AccessLog(mPacket, "Stored session id didn't match packet session id!")
End If End If
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
@ -122,14 +122,14 @@ Public Class RDSHandler
' TODO: Fix race-condition RD Web vs. Gateway. Don't start RDP client in RD Web ' TODO: Fix race-condition RD Web vs. Gateway. Don't start RDP client in RD Web
' before ensuring App Launch request was successful ' before ensuring App Launch request was successful
Public Sub ProcessGatewayRequest() Public Sub ProcessGatewayRequest()
RDSFactor.AccessLog("Gateway Request for user: " & mUsername) RDSFactor.AccessLog(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("User's has no launch window. User must re-authenticate") RDSFactor.AccessLog(mPacket, "User's has no launch window. User must re-authenticate")
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
Exit Sub Exit Sub
End If End If
@ -142,12 +142,13 @@ Public Class RDSHandler
Dim secondsSinceLaunch = DateDiff(DateInterval.Second, launchTimestamp, Now) Dim secondsSinceLaunch = DateDiff(DateInterval.Second, launchTimestamp, Now)
If secondsSinceLaunch < RDSFactor.LaunchTimeOut Then If secondsSinceLaunch < RDSFactor.LaunchTimeOut Then
RDSFactor.AccessLog("Allowing access through gateway for user: " & mUsername & " -- closing window") RDSFactor.AccessLog(mPacket, "Opening gateway connection window")
mPacket.AcceptAccessRequest(attributes) mPacket.AcceptAccessRequest(attributes)
Else Else
RDSFactor.AccessLog("Launch window has closed!") RDSFactor.AccessLog(mPacket, "Gateway connection window has timed out!")
End If End If
RDSFactor.AccessLog(mPacket, "Removing gateway connection window")
' close window ' close window
userLaunchTimestamps.Remove(mUsername) userLaunchTimestamps.Remove(mUsername)
End Sub End Sub
@ -160,7 +161,7 @@ Public Class RDSHandler
Exit Sub Exit Sub
End If End If
RDSFactor.AccessLog("ProcessAccessRequest") RDSFactor.AccessLog(mPacket, "AccessRequest")
Try Try
Dim ldapResult = Authenticate() Dim ldapResult = Authenticate()
@ -171,13 +172,13 @@ Public Class RDSHandler
Accept() Accept()
End If End If
Catch ex As Exception Catch ex As Exception
RDSFactor.AccessLog("Authentication failed. Sending reject. Error: " & ex.Message) RDSFactor.AccessLog(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("Accept") RDSFactor.AccessLog(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
@ -190,7 +191,7 @@ Public Class RDSHandler
End Sub End Sub
Private Sub ProcessChallengeResponse() Private Sub ProcessChallengeResponse()
RDSFactor.AccessLog("ProcessChallengeResponse") RDSFactor.AccessLog(mPacket, "ChallengeResponse")
' 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
@ -207,17 +208,17 @@ Public Class RDSHandler
Private Sub TwoFactorChallenge() Private Sub TwoFactorChallenge()
Dim code = RDSFactor.GenerateCode Dim code = RDSFactor.GenerateCode
Dim sid = EncDec.Encrypt(mUsername & "_" & code, RDSFactor.encCode) 'generate unique code Dim sid = EncDec.Encrypt(mUsername & "_" & code, RDSFactor.encCode) 'generate unique code
RDSFactor.AccessLog("Access Challange Code: " & code) RDSFactor.AccessLog(mPacket, "Access Challange Code: " & code)
userSidTokens(mUsername) = sid userSidTokens(mUsername) = sid
tokenTimestamps(mUsername) = Now tokenTimestamps(mUsername) = Now
If mUseSMSFactor Then If mUseSMSFactor Then
RDSFactor.AccessLog("TODO: Send SMS") RDSFactor.AccessLog(mPacket, "TODO: Send SMS")
End If End If
If mUseEmailFactor Then If mUseEmailFactor Then
RDSFactor.AccessLog("TODO: Send Email") RDSFactor.AccessLog(mPacket, "TODO: Send Email")
End If End If
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
@ -235,7 +236,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("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & mUsername) RDSFactor.AccessLog(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
@ -256,7 +257,7 @@ Public Class RDSHandler
Dim result = search.FindOne() Dim result = search.FindOne()
If IsDBNull(result) Then If IsDBNull(result) Then
RDSFactor.AccessLog("Failed to authenticate with Active Directory") RDSFactor.AccessLog(mPacket, "Failed to authenticate with Active Directory")
Throw New MissingUser Throw New MissingUser
End If End If
@ -267,7 +268,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("Unable to find correct phone number for user " & mUsername) RDSFactor.AccessLog(mPacket, "Unable to find correct phone number for user " & mUsername)
End If End If
Return mobile Return mobile
End Function End Function
@ -276,7 +277,7 @@ 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("Unable to find correct email for user " & mUsername) RDSFactor.AccessLog(mPacket, "Unable to find correct email for user " & mUsername)
End If End If
Return email Return email
End Function End Function