From 59885e7c5a08221f66888439b4da2aa6eca2e9d3 Mon Sep 17 00:00:00 2001 From: "Jakob A. Dam" Date: Thu, 16 Apr 2015 08:56:46 +0200 Subject: [PATCH] Better log output --- RDSFactor/RDSFactor.vb | 12 ++++++-- RDSFactor/handlers/CitrixHandler.vb | 44 +++++++++++++++-------------- RDSFactor/handlers/RDSHandler.vb | 41 ++++++++++++++------------- 3 files changed, 53 insertions(+), 44 deletions(-) diff --git a/RDSFactor/RDSFactor.vb b/RDSFactor/RDSFactor.vb index 066c8bd..88ab61b 100644 --- a/RDSFactor/RDSFactor.vb +++ b/RDSFactor/RDSFactor.vb @@ -129,13 +129,19 @@ Public Class RDSFactor ProcessPacket(radius1645, packet) 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 - UserAccessLog.WriteLog(Now & ": DEBUG: " & message) + UserAccessLog.WriteLog(message) ' Also write to the console if not a service If Environment.UserInteractive Then - Console.WriteLine(Now & ": DEBUG: " & message) + Console.WriteLine(message) End If End If End Sub diff --git a/RDSFactor/handlers/CitrixHandler.vb b/RDSFactor/handlers/CitrixHandler.vb index c0e8c4d..9cbff01 100644 --- a/RDSFactor/handlers/CitrixHandler.vb +++ b/RDSFactor/handlers/CitrixHandler.vb @@ -7,6 +7,8 @@ Imports RADAR ' Look in RDSHandler how this should be refactored. Public Class CitrixHandler + Private mPacket As RADIUSPacket + Public Sub New(packet As RADIUSPacket) End Sub @@ -17,7 +19,7 @@ Public Class CitrixHandler ' and drop other requests silently ... 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 End If @@ -36,11 +38,11 @@ Public Class CitrixHandler ' will return Nothing. If username Is Nothing Then ' 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 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 ' Exit Sub @@ -49,16 +51,16 @@ Public Class CitrixHandler 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. 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 = "" 'lets see if user login using upd or UPN name Dim sUserName As String = username.ToString Dim sPassword As String = packet.UserPassword - RDSFactor.AccessLog("SMSToken supplied by user: " & sUserName) + RDSFactor.AccessLog(mPacket, "SMSToken supplied by user: " & sUserName) sid = "" If InStr(sUserName, "@") > 0 Then 'UPN @@ -69,7 +71,7 @@ Public Class CitrixHandler End If 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 packet.AcceptAccessRequest() Else @@ -100,7 +102,7 @@ Public Class CitrixHandler UserDomain = RDSFactor.NetBiosDomain & "\" & sUserName 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 ' 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() '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 success = False - RDSFactor.AccessLog("Unable to find correct email for user " & UserDomain) + RDSFactor.AccessLog(mPacket, "Unable to find correct email for user " & UserDomain) Else success = True End If Catch - RDSFactor.AccessLog("Unable to find correct email for user " & UserDomain) + RDSFactor.AccessLog(mPacket, "Unable to find correct email for user " & UserDomain) success = False End Try End If @@ -162,12 +164,12 @@ Public Class CitrixHandler mobile = Replace(mobile, "+", "") If mobile.Trim.Length = 0 Then 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 success = True End If 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 End Try @@ -183,12 +185,12 @@ Public Class CitrixHandler 'If userHash.ContainsKey(sid) Then ' userHash(sid) = sPassword ' If DEBUG = True Then - ' CICRadarR.AccessLog("Updating userHash " & sid) + ' CICRadarR.AccessLog(mPacket, "Updating userHash " & sid) ' End If 'Else ' userHash.Add(sid, sPassword) ' If DEBUG = True Then - ' CICRadarR.AccessLog("Adding userHash " & sid) + ' CICRadarR.AccessLog(mPacket, "Adding userHash " & sid) ' End If 'End If ' new code stored in AD now send it to the users phone @@ -199,7 +201,7 @@ Public Class CitrixHandler success = False End If 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 End Try @@ -207,7 +209,7 @@ Public Class CitrixHandler Dim attributes As New RADIUSAttributes 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 Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token") attributes.Add(attr) @@ -220,21 +222,21 @@ Public Class CitrixHandler packet.EndPoint), _ packet.Authenticator) 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) End If 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) End If 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() End If ' packetHash.Remove(username.GetString & "_" & pass.GetString) 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) server.SendAsResponse(pk, packet.Authenticator) ' FYI ... if no additional attributes need to be added diff --git a/RDSFactor/handlers/RDSHandler.vb b/RDSFactor/handlers/RDSHandler.vb index 9e3c0de..a7e2cd0 100644 --- a/RDSFactor/handlers/RDSHandler.vb +++ b/RDSFactor/handlers/RDSHandler.vb @@ -75,7 +75,7 @@ Public Class RDSHandler ' NOTE: Requests contain the session GUID in the password attribute ' of the packet. Public Sub ProcessAppLaunchRequest() - RDSFactor.AccessLog("ProcessAppLaunchRequest") + RDSFactor.AccessLog(mPacket, "AppLaunchRequest") ' When the packet is an AppLaunchRequest the password attribute contains the session id! Dim packetSessionId = mPassword @@ -83,7 +83,7 @@ Public Class RDSHandler Dim sessionTimestamp = sessionTimestamps(mUsername) 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() Exit Sub End If @@ -91,7 +91,7 @@ Public Class RDSHandler If packetSessionId = storedSessionId Then Dim minsSinceLastActivity = DateDiff(DateInterval.Minute, sessionTimestamp, Now) If minsSinceLastActivity < RDSFactor.SessionTimeOut Then - RDSFactor.AccessLog("Opening window for: " & mUsername) + RDSFactor.AccessLog(mPacket, "Opening window") ' Pro-long session sessionTimestamps(storedSessionId) = Now ' Open launch window @@ -99,12 +99,12 @@ Public Class RDSHandler mPacket.AcceptAccessRequest() Exit Sub Else - RDSFactor.AccessLog("Session timed out -- User MUST re-authenticate") + RDSFactor.AccessLog(mPacket, "Session timed out -- User MUST re-authenticate") userSessions.Remove(mUsername) sessionTimestamps.Remove(mUsername) End If 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 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 ' before ensuring App Launch request was successful Public Sub ProcessGatewayRequest() - RDSFactor.AccessLog("Gateway Request for user: " & mUsername) + RDSFactor.AccessLog(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("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() Exit Sub End If @@ -142,12 +142,13 @@ Public Class RDSHandler Dim secondsSinceLaunch = DateDiff(DateInterval.Second, launchTimestamp, Now) 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) Else - RDSFactor.AccessLog("Launch window has closed!") + RDSFactor.AccessLog(mPacket, "Gateway connection window has timed out!") End If + RDSFactor.AccessLog(mPacket, "Removing gateway connection window") ' close window userLaunchTimestamps.Remove(mUsername) End Sub @@ -160,7 +161,7 @@ Public Class RDSHandler Exit Sub End If - RDSFactor.AccessLog("ProcessAccessRequest") + RDSFactor.AccessLog(mPacket, "AccessRequest") Try Dim ldapResult = Authenticate() @@ -171,13 +172,13 @@ Public Class RDSHandler Accept() End If 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() End Try End Sub Private Sub Accept() - RDSFactor.AccessLog("Accept") + RDSFactor.AccessLog(mPacket, "AcceptAccessRequest") Dim sGUID As String = System.Guid.NewGuid.ToString() userSessions(mUsername) = sGUID sessionTimestamps(mUsername) = Now @@ -190,7 +191,7 @@ Public Class RDSHandler End Sub Private Sub ProcessChallengeResponse() - RDSFactor.AccessLog("ProcessChallengeResponse") + RDSFactor.AccessLog(mPacket, "ChallengeResponse") ' When the packet is an Challange-Response the password attr. contains the token Dim challangeCode = mPassword @@ -207,17 +208,17 @@ Public Class RDSHandler Private Sub TwoFactorChallenge() Dim code = RDSFactor.GenerateCode 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 tokenTimestamps(mUsername) = Now If mUseSMSFactor Then - RDSFactor.AccessLog("TODO: Send SMS") + RDSFactor.AccessLog(mPacket, "TODO: Send SMS") End If If mUseEmailFactor Then - RDSFactor.AccessLog("TODO: Send Email") + RDSFactor.AccessLog(mPacket, "TODO: Send Email") End If Dim attributes As New RADIUSAttributes @@ -235,7 +236,7 @@ Public Class RDSHandler Dim password As String = mPacket.UserPassword 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 obj As Object = dirEntry.NativeObject @@ -256,7 +257,7 @@ Public Class RDSHandler Dim result = search.FindOne() If IsDBNull(result) Then - RDSFactor.AccessLog("Failed to authenticate with Active Directory") + RDSFactor.AccessLog(mPacket, "Failed to authenticate with Active Directory") Throw New MissingUser End If @@ -267,7 +268,7 @@ Public Class RDSHandler Dim mobile = result.Properties(RDSFactor.ADField)(0) mobile = Replace(mobile, "+", "") 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 Return mobile End Function @@ -276,7 +277,7 @@ Public Class RDSHandler Dim email = result.Properties(RDSFactor.ADMailField)(0) 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 Return email End Function