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

Merge branch 'master' of https://github.com/jakobadam/RDSfactor

Browse source
This commit is contained in:
Jakob A. Dam 2015-04-20 11:41:18 +02:00
commit d558eba854
6 changed files with 150 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

17
RDSFactor/RDSFactor.Designer.vb generated
View file

@ -49,20 +49,21 @@ Partial Class RDSFactor
' Do not modify it using the code editor. ' Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> _ <System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent() Private Sub InitializeComponent()
Me.TimerCleanUpHash = New System.Timers.Timer() Me.cleanupEvent = New System.Timers.Timer()
CType(Me.TimerCleanUpHash, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.cleanupEvent, System.ComponentModel.ISupportInitialize).BeginInit()
' '
'TimerCleanUpHash 'cleanupEvent
' '
Me.TimerCleanUpHash.Enabled = True Me.cleanupEvent.Enabled = True
Me.TimerCleanUpHash.Interval = 60000.0R Me.cleanupEvent.Interval = 60000.0R
' '
'CICRadarR 'RDSFactor
' '
Me.ServiceName = "Service1" Me.ServiceName = "Service1"
CType(Me.TimerCleanUpHash, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.cleanupEvent, System.ComponentModel.ISupportInitialize).EndInit()
End Sub End Sub
Friend WithEvents TimerCleanUpHash As System.Timers.Timer
Public WithEvents cleanupEvent As System.Timers.Timer
End Class End Class

2
RDSFactor/RDSFactor.resx
View file

@ -117,7 +117,7 @@
<resheader name="writer"> <resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader> </resheader>
<metadata name="TimerCleanUpHash.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="cleanupEvent.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value> <value>17, 17</value>
</metadata> </metadata>
<metadata name="$this.TrayLargeIcon" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="$this.TrayLargeIcon" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">

48
RDSFactor/RDSFactor.vb
View file

@ -44,11 +44,6 @@ Public Class RDSFactor
Private Shared SenderEmail As String = "" Private Shared SenderEmail As String = ""
Private TSGW 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 SessionTimeOut As Integer = 30 ' in minutes
Public Shared LaunchTimeOut As Integer = 30 ' in seconds Public Shared LaunchTimeOut As Integer = 30 ' in seconds
@ -129,13 +124,20 @@ 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
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 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
@ -344,34 +346,10 @@ Public Class RDSFactor
End If End If
Return "FAILED" Return "FAILED"
End Try End Try
End Function End Function
Private Sub TimerCleanUpHash_Elapsed(sender As System.Object, e As System.Timers.ElapsedEventArgs) Handles TimerCleanUpHash.Elapsed Public Sub CleanupEventHandler(sender, e) Handles cleanupEvent.Elapsed
' Clean Session and Launch hash for TSGW RDSHandler.Cleanup()
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
End Sub End Sub
End Class End Class

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

122
RDSFactor/handlers/RDSHandler.vb
View file

@ -5,10 +5,7 @@ Public Class RDSHandler
Private Shared userSessions As New Hashtable Private Shared userSessions As New Hashtable
Private Shared sessionTimestamps As New Hashtable Private Shared sessionTimestamps As New Hashtable
Private Shared userSidTokens As New Hashtable Private Shared userSidTokens As New Hashtable
Private Shared tokenTimestamps As New Hashtable
Private Shared userLaunchTimestamps As New Hashtable Private Shared userLaunchTimestamps As New Hashtable
Private mPacket As RADIUSPacket Private mPacket As RADIUSPacket
@ -75,41 +72,64 @@ 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
Dim storedSessionId = userSessions(mUsername) Dim storedSessionId = userSessions(mUsername)
Dim sessionTimestamp = sessionTimestamps(mUsername)
If storedSessionId = Nothing Or sessionTimestamp = Nothing Then If storedSessionId = 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
If packetSessionId = storedSessionId Then If Not storedSessionId = packetSessionId Then
Dim minsSinceLastActivity = DateDiff(DateInterval.Minute, sessionTimestamp, Now) RDSFactor.AccessLog(mPacket, "Stored session id didn't match packet session id!")
If minsSinceLastActivity < RDSFactor.SessionTimeOut Then mPacket.RejectAccessRequest()
RDSFactor.AccessLog("Opening window for: " & mUsername) Exit Sub
' Pro-long session End If
sessionTimestamps(storedSessionId) = Now
' Open launch window If HasValidSession(mUsername) Then
userLaunchTimestamps(mUsername) = Now RDSFactor.AccessLog(mPacket, "Opening window")
mPacket.AcceptAccessRequest() ' Pro-long user session
Exit Sub sessionTimestamps(mUsername) = Now
Else ' Open gateway connection window
RDSFactor.AccessLog("Session timed out -- User MUST re-authenticate") userLaunchTimestamps(mUsername) = Now
userSessions.Remove(mUsername) mPacket.AcceptAccessRequest()
sessionTimestamps.Remove(mUsername) Exit Sub
End If Else
Else RDSFactor.AccessLog(mPacket, "Session timed out -- User MUST re-authenticate")
RDSFactor.AccessLog("Stored session id didn't match packet session id!") userSessions.Remove(mUsername)
sessionTimestamps.Remove(mUsername)
mPacket.RejectAccessRequest()
End If End If
mPacket.RejectAccessRequest()
End Sub 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. ' 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. ' 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 ' 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
@ -140,15 +160,15 @@ Public Class RDSHandler
attributes.Add(proxyState) attributes.Add(proxyState)
End If End If
Dim secondsSinceLaunch = DateDiff(DateInterval.Second, launchTimestamp, Now) If HasValidLaunchWindow(mUsername) Then
If secondsSinceLaunch < RDSFactor.LaunchTimeOut Then RDSFactor.AccessLog(mPacket, "Opening gateway launch window")
RDSFactor.AccessLog("Allowing access through gateway for user: " & mUsername & " -- closing window")
mPacket.AcceptAccessRequest(attributes) mPacket.AcceptAccessRequest(attributes)
Else Else
RDSFactor.AccessLog("Launch window has closed!") RDSFactor.AccessLog(mPacket, "Gateway launch window has timed out!")
mPacket.RejectAccessRequest()
End If End If
' close window RDSFactor.AccessLog(mPacket, "Removing gateway launch window")
userLaunchTimestamps.Remove(mUsername) userLaunchTimestamps.Remove(mUsername)
End Sub End Sub
@ -160,7 +180,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 +191,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 +210,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
@ -198,6 +218,7 @@ Public Class RDSHandler
Dim sid = EncDec.Encrypt(mUsername & "_" & challangeCode, RDSFactor.encCode) Dim sid = EncDec.Encrypt(mUsername & "_" & challangeCode, RDSFactor.encCode)
If sid = state.ToString Then If sid = state.ToString Then
userSidTokens.Remove(mUsername)
Accept() Accept()
Else Else
mPacket.RejectAccessRequest() mPacket.RejectAccessRequest()
@ -207,17 +228,16 @@ 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
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 +255,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 +276,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 +287,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,10 +296,24 @@ 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
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 End Class

29
README.md
View file

@ -4,13 +4,36 @@ Two-factor authentication for Remote Desktop Services (RDS)
http://www.isager.dk/is/CICRadarR/SMStokenforWindows2012RDGateway.aspx 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 ## 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 ## Acknowledgements
* Claus Isager - for the proof of concept two factor RDS authentication * Claus Isager - for the proof of concept two factor RDS authentication
* Nikolay Semov - for the core RADIUS server * Nikolay Semov - for the core RADIUS server