diff --git a/RDSFactor/RDSFactor.Designer.vb b/RDSFactor/RDSFactor.Designer.vb index d64313d..a56e8b3 100644 --- a/RDSFactor/RDSFactor.Designer.vb +++ b/RDSFactor/RDSFactor.Designer.vb @@ -49,20 +49,21 @@ Partial Class RDSFactor ' Do not modify it using the code editor. _ Private Sub InitializeComponent() - Me.TimerCleanUpHash = New System.Timers.Timer() - CType(Me.TimerCleanUpHash, System.ComponentModel.ISupportInitialize).BeginInit() + Me.cleanupEvent = New System.Timers.Timer() + CType(Me.cleanupEvent, System.ComponentModel.ISupportInitialize).BeginInit() ' - 'TimerCleanUpHash + 'cleanupEvent ' - Me.TimerCleanUpHash.Enabled = True - Me.TimerCleanUpHash.Interval = 60000.0R + Me.cleanupEvent.Enabled = True + Me.cleanupEvent.Interval = 60000.0R ' - 'CICRadarR + 'RDSFactor ' Me.ServiceName = "Service1" - CType(Me.TimerCleanUpHash, System.ComponentModel.ISupportInitialize).EndInit() + CType(Me.cleanupEvent, System.ComponentModel.ISupportInitialize).EndInit() End Sub - Friend WithEvents TimerCleanUpHash As System.Timers.Timer + + Public WithEvents cleanupEvent As System.Timers.Timer End Class diff --git a/RDSFactor/RDSFactor.resx b/RDSFactor/RDSFactor.resx index 734d56d..e22b5c6 100644 --- a/RDSFactor/RDSFactor.resx +++ b/RDSFactor/RDSFactor.resx @@ -117,7 +117,7 @@ System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - + 17, 17 diff --git a/RDSFactor/RDSFactor.vb b/RDSFactor/RDSFactor.vb index 066c8bd..edae5d1 100644 --- a/RDSFactor/RDSFactor.vb +++ b/RDSFactor/RDSFactor.vb @@ -44,11 +44,6 @@ Public Class RDSFactor Private Shared SenderEmail As String = "" Private TSGW As String = "" - Private TSGWSessionIdHash As New Hashtable - Private TSGWSessionIdTimeStampHash As New Hashtable - Private TSGWLaunchIdTimeStampHash As New Hashtable - Private TSGWFirstLoginHash As New Hashtable ' Ensure that only one sms is send even if radius need to re-authenticate. - Private TSGWFirstLoginTimeStampHash As New Hashtable ' Ensure that only one sms is send even if radius need to re-authenticate. Public Shared SessionTimeOut As Integer = 30 ' in minutes Public Shared LaunchTimeOut As Integer = 30 ' in seconds @@ -129,13 +124,20 @@ 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 + message = "[" & packet.UserName & " " & from_address & "] " & message + AccessLog(message) + End Sub + + Public Shared Sub AccessLog(message As String) + message = Now & ": DEBUG: " & message 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 @@ -344,34 +346,10 @@ Public Class RDSFactor End If Return "FAILED" End Try - - - End Function - Private Sub TimerCleanUpHash_Elapsed(sender As System.Object, e As System.Timers.ElapsedEventArgs) Handles TimerCleanUpHash.Elapsed - ' Clean Session and Launch hash for TSGW - Try - Dim Item As DictionaryEntry - For Each Item In TSGWSessionIdTimeStampHash - Dim hTime As DateTime = DirectCast(Item.Value, DateTime) - Dim tValid = DateDiff(DateInterval.Minute, hTime, Now) - If tValid >= SessionTimeOut Then - TSGWSessionIdTimeStampHash.Remove(Item.Key) - If TSGWSessionIdHash.Contains(Item.Key) Then - TSGWSessionIdHash.Remove(Item.Key) - End If - End If - Next - - For Each Item In TSGWLaunchIdTimeStampHash - Dim hTime As DateTime = DirectCast(Item.Value, DateTime) - Dim tValid = DateDiff(DateInterval.Second, hTime, Now) - If tValid >= LaunchTimeOut Then - TSGWLaunchIdTimeStampHash.Remove(Item.Key) - End If - Next - Catch - End Try + Public Sub CleanupEventHandler(sender, e) Handles cleanupEvent.Elapsed + RDSHandler.Cleanup() End Sub + End Class 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..c7529bb 100644 --- a/RDSFactor/handlers/RDSHandler.vb +++ b/RDSFactor/handlers/RDSHandler.vb @@ -5,10 +5,7 @@ Public Class RDSHandler Private Shared userSessions As New Hashtable Private Shared sessionTimestamps As New Hashtable - Private Shared userSidTokens As New Hashtable - Private Shared tokenTimestamps As New Hashtable - Private Shared userLaunchTimestamps As New Hashtable Private mPacket As RADIUSPacket @@ -75,41 +72,64 @@ 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 Dim storedSessionId = userSessions(mUsername) - Dim sessionTimestamp = sessionTimestamps(mUsername) - If storedSessionId = Nothing Or sessionTimestamp = Nothing Then - RDSFactor.AccessLog("User has no session. MUST re-authenticate!") + If storedSessionId = Nothing Then + RDSFactor.AccessLog(mPacket, "User has no session. MUST re-authenticate!") mPacket.RejectAccessRequest() Exit Sub End If - If packetSessionId = storedSessionId Then - Dim minsSinceLastActivity = DateDiff(DateInterval.Minute, sessionTimestamp, Now) - If minsSinceLastActivity < RDSFactor.SessionTimeOut Then - RDSFactor.AccessLog("Opening window for: " & mUsername) - ' Pro-long session - sessionTimestamps(storedSessionId) = Now - ' Open launch window - userLaunchTimestamps(mUsername) = Now - mPacket.AcceptAccessRequest() - Exit Sub - Else - RDSFactor.AccessLog("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!") + If Not storedSessionId = packetSessionId Then + RDSFactor.AccessLog(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") + ' Pro-long user session + sessionTimestamps(mUsername) = Now + ' Open gateway connection window + userLaunchTimestamps(mUsername) = Now + mPacket.AcceptAccessRequest() + Exit Sub + Else + RDSFactor.AccessLog(mPacket, "Session timed out -- User MUST re-authenticate") + userSessions.Remove(mUsername) + sessionTimestamps.Remove(mUsername) + mPacket.RejectAccessRequest() End If - mPacket.RejectAccessRequest() End Sub + Public Shared Function HasValidLaunchWindow(username) As Boolean + Dim timestamp = userLaunchTimestamps(username) + + Dim secondsSinceLaunch = DateDiff(DateInterval.Second, timestamp, Now) + If secondsSinceLaunch < RDSFactor.LaunchTimeOut Then + Return True + Else + Return False + End If + End Function + + Public Shared Function HasValidSession(username) As Boolean + Dim id = userSessions(username) + Dim timestamp = sessionTimestamps(username) + + Dim minsSinceLastActivity = DateDiff(DateInterval.Minute, timestamp, Now) + If minsSinceLastActivity < RDSFactor.SessionTimeOut Then + Return True + Else + Return False + End If + End Function + ' Process the request from the Network Policy Server in the RDS Gateway. ' These are sent when an RDP client tries to connect through the Gateway. ' @@ -122,14 +142,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 @@ -140,15 +160,15 @@ Public Class RDSHandler attributes.Add(proxyState) End If - Dim secondsSinceLaunch = DateDiff(DateInterval.Second, launchTimestamp, Now) - If secondsSinceLaunch < RDSFactor.LaunchTimeOut Then - RDSFactor.AccessLog("Allowing access through gateway for user: " & mUsername & " -- closing window") + If HasValidLaunchWindow(mUsername) Then + RDSFactor.AccessLog(mPacket, "Opening gateway launch window") mPacket.AcceptAccessRequest(attributes) Else - RDSFactor.AccessLog("Launch window has closed!") + RDSFactor.AccessLog(mPacket, "Gateway launch window has timed out!") + mPacket.RejectAccessRequest() End If - ' close window + RDSFactor.AccessLog(mPacket, "Removing gateway launch window") userLaunchTimestamps.Remove(mUsername) End Sub @@ -160,7 +180,7 @@ Public Class RDSHandler Exit Sub End If - RDSFactor.AccessLog("ProcessAccessRequest") + RDSFactor.AccessLog(mPacket, "AccessRequest") Try Dim ldapResult = Authenticate() @@ -171,13 +191,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 +210,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 @@ -198,6 +218,7 @@ Public Class RDSHandler Dim sid = EncDec.Encrypt(mUsername & "_" & challangeCode, RDSFactor.encCode) If sid = state.ToString Then + userSidTokens.Remove(mUsername) Accept() Else mPacket.RejectAccessRequest() @@ -207,17 +228,16 @@ 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 +255,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 +276,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 +287,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,10 +296,24 @@ 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 + Public Shared Sub Cleanup() + RDSFactor.AccessLog("TimerCleanUp") + + Dim users = New ArrayList(userSessions.Keys) + For Each username In users + If Not HasValidSession(username) Then + userSessions.Remove(username) + sessionTimestamps.Remove(username) + userLaunchTimestamps.Remove(username) + userSidTokens.Remove(username) + End If + Next + End Sub + End Class diff --git a/README.md b/README.md index 080c549..bb51fd3 100644 --- a/README.md +++ b/README.md @@ -4,13 +4,36 @@ Two-factor authentication for Remote Desktop Services (RDS) http://www.isager.dk/is/CICRadarR/SMStokenforWindows2012RDGateway.aspx +## Prerequisites + +An RDS setup. The minimal RDS setup for use with RDSFactor consist of two servers: +* Active Directory; and +* RDS with Gateway component enabled + ## Installation -Hmm. TODO. +### RDWeb update +RDSfactor comes with a customized version of the RDWeb pages. To install these run: + +``` +$ install-web.bat +``` + +After install go and configure the application in IIS. RDWeb -> Pages -> Application Settings. You should configure the following settings: +* RadiusServer (IP of the radius server) +* RadiusSecret (Shared secret used for encryption of RADIUS traffic) + +### RADIUS server installation + +The RADIUS server component can be installed on any server reacheable by both the RD Web and the RD Gateway. To install the server as a service run: + +``` +$ install-server.bat +``` + +TODO: NPS config, Web config ## Acknowledgements * Claus Isager - for the proof of concept two factor RDS authentication * Nikolay Semov - for the core RADIUS server - -