mirror of
https://github.com/jakobadam/RDSFactor.git
synced 2025-06-06 20:45:28 +02:00
Removed old RDS handling code
This commit is contained in:
Jakob A. Dam
Jakob Aarøe Dam
parent
fd9c8db357
commit
ffc11edc06
2 changed files with 1 additions and 404 deletions
|
|
@ -153,410 +153,6 @@ Public Class CICRadarR
|
||||||
handler.ProcessRequest()
|
handler.ProcessRequest()
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
Sub ProcessPacketTSGW(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)
|
|
||||||
|
|
||||||
' Let's take a look at just authentication requests,
|
|
||||||
' and drop other requests silently ...
|
|
||||||
|
|
||||||
If packet.Code <> RadiusPacketCode.AccessRequest Then
|
|
||||||
AccessLog("Not a valid radius packet.. Drop!")
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
AccessLog("Radius packet recived")
|
|
||||||
|
|
||||||
Dim LaunchApp As String = ""
|
|
||||||
Dim launchTSGW As String = ""
|
|
||||||
If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then
|
|
||||||
Dim VSAtt As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.VendorSpecific)
|
|
||||||
Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
|
|
||||||
For Each atts As RADIUSAttribute In VSAtts
|
|
||||||
'Dim opt As String = atts.GetHex().Trim
|
|
||||||
'Console.WriteLine(atts.GetVendorSpecific.VendorValue.ToString)
|
|
||||||
'Select Case opt
|
|
||||||
' Case "4C 41 55 4E 43 48" ' ok, I was lasy. Need to write code to resolve value in (26) Vendor specific.
|
|
||||||
' LaunchApp = "LAUNCH"
|
|
||||||
' Case "00 00 01 37 2F 06 00 00 00 01"
|
|
||||||
' launchTSGW = "LAUNCH"
|
|
||||||
'End Select
|
|
||||||
'Console.WriteLine(atts.GetHex())
|
|
||||||
|
|
||||||
Dim opt As String = atts.GetVendorSpecific.VendorValue.ToString
|
|
||||||
|
|
||||||
Select Case UCase(opt)
|
|
||||||
Case "LAUNCH"
|
|
||||||
LaunchApp = "LAUNCH"
|
|
||||||
Case "TSGATEWAY"
|
|
||||||
launchTSGW = "LAUNCH"
|
|
||||||
End Select
|
|
||||||
Next
|
|
||||||
' LaunchApp = VSAtt.GetString
|
|
||||||
End If
|
|
||||||
|
|
||||||
' Let's see if we have a username present ...
|
|
||||||
Dim username As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserName)
|
|
||||||
Dim pass As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserPassword)
|
|
||||||
|
|
||||||
|
|
||||||
If LaunchApp = "LAUNCH" Then
|
|
||||||
Dim sRadiusSessionId = packet.UserPassword
|
|
||||||
Dim SessionId_Ok As Boolean = False
|
|
||||||
Dim sUserName As String = username.ToString.ToLower
|
|
||||||
|
|
||||||
AccessLog("RDWeb app launch: Checking token validity of user: " & sUserName)
|
|
||||||
|
|
||||||
If TSGWSessionIdHash.Contains(sUserName) And TSGWSessionIdTimeStampHash.Contains(sUserName) Then
|
|
||||||
Dim hashTime As DateTime = DirectCast(TSGWSessionIdTimeStampHash(sUserName), DateTime)
|
|
||||||
Dim tValid = DateDiff(DateInterval.Minute, hashTime, Now)
|
|
||||||
If tValid < SessionTimeOut Then
|
|
||||||
' check session id
|
|
||||||
If sRadiusSessionId = DirectCast(TSGWSessionIdHash(sUserName), String) Then ' Session id match
|
|
||||||
SessionId_Ok = True
|
|
||||||
If TSGWLaunchIdTimeStampHash.Contains(sUserName) Then
|
|
||||||
TSGWLaunchIdTimeStampHash(sUserName) = Now
|
|
||||||
Else
|
|
||||||
TSGWLaunchIdTimeStampHash.Add(sUserName, Now)
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
End If
|
|
||||||
|
|
||||||
If SessionId_Ok Then
|
|
||||||
packet.AcceptAccessRequest()
|
|
||||||
Else
|
|
||||||
packet.RejectAccessRequest()
|
|
||||||
End If
|
|
||||||
|
|
||||||
ElseIf launchTSGW = "LAUNCH" Then
|
|
||||||
|
|
||||||
Dim sRadiusSessionId = packet.UserPassword
|
|
||||||
Dim attributes As New RADIUSAttributes
|
|
||||||
Dim proxyState As String
|
|
||||||
Dim LaunchId_Ok As Boolean = False
|
|
||||||
Dim sUserName As String = username.ToString.ToLower
|
|
||||||
|
|
||||||
AccessLog("TSGateway Connection checking token validity of user: " & sUserName)
|
|
||||||
|
|
||||||
Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
|
|
||||||
If existProxyState = True Then
|
|
||||||
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).ToString
|
|
||||||
AccessLog("Packet contains a state attribute ProxyState=" & proxyState)
|
|
||||||
attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
|
|
||||||
End If
|
|
||||||
|
|
||||||
'Check launchHash to see if user hash a valid launch window (default 30 sec.)
|
|
||||||
|
|
||||||
If TSGWLaunchIdTimeStampHash.Contains(sUserName) = True Then ' user has a launch id lets check if it valid
|
|
||||||
Dim hashTime As DateTime = DirectCast(TSGWLaunchIdTimeStampHash(sUserName), DateTime)
|
|
||||||
Dim tValid = DateDiff(DateInterval.Second, hashTime, Now)
|
|
||||||
If tValid < LaunchTimeOut Then
|
|
||||||
AccessLog("User " & sUserName & " has valid token.")
|
|
||||||
LaunchId_Ok = True ' Launch ok now add launch hash key
|
|
||||||
TSGWLaunchIdTimeStampHash.Remove(sUserName)
|
|
||||||
Else
|
|
||||||
AccessLog("Token of " & sUserName & " timed out.")
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
AccessLog(sUserName & " has no entry in db.")
|
|
||||||
End If
|
|
||||||
|
|
||||||
If LaunchId_Ok Then ' found match in hash table' Return ok
|
|
||||||
packet.AcceptAccessRequest(attributes)
|
|
||||||
Else
|
|
||||||
packet.RejectAccessRequest()
|
|
||||||
End If
|
|
||||||
|
|
||||||
Else
|
|
||||||
Dim sid As String = ""
|
|
||||||
Dim mobile As String = ""
|
|
||||||
Dim email As String = ""
|
|
||||||
Dim smsCode As String = ""
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
' If an attribute of a particular type is not found, the function
|
|
||||||
' will return Nothing.
|
|
||||||
If username Is Nothing Then
|
|
||||||
' Technically, this case is against RFC, so ... drop.
|
|
||||||
AccessLog("Not a valid radius packet.. No username present.. Drop!")
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
AccessLog("Processing packet for user: " & username.ToString)
|
|
||||||
|
|
||||||
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
|
|
||||||
Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
|
|
||||||
|
|
||||||
If existState = True Then ' Ok we have at packet with the State attribute set. Check if we can identify the authtentication packet. (User provides the sms token)
|
|
||||||
Dim state As String
|
|
||||||
Dim proxyState As String
|
|
||||||
|
|
||||||
state = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).ToString
|
|
||||||
AccessLog("Packet contains a state attribute State=" & state)
|
|
||||||
|
|
||||||
If existProxyState = True Then
|
|
||||||
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).ToString
|
|
||||||
AccessLog("Packet contains a state attribute State=" & proxyState)
|
|
||||||
End If
|
|
||||||
|
|
||||||
|
|
||||||
Dim UserDomain As String = ""
|
|
||||||
'lets see if user login using upd or UPN name
|
|
||||||
Dim sUserName As String = username.ToString.ToLower
|
|
||||||
Dim sPassword As String = packet.UserPassword
|
|
||||||
|
|
||||||
AccessLog("SMSToken supplied by user: " & sUserName)
|
|
||||||
|
|
||||||
sid = ""
|
|
||||||
If InStr(sUserName, "@") > 0 Then 'UPN
|
|
||||||
UserDomain = sUserName
|
|
||||||
Else 'UPD
|
|
||||||
'read domain from Hashtable
|
|
||||||
UserDomain = sUserName
|
|
||||||
End If
|
|
||||||
|
|
||||||
sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode)
|
|
||||||
|
|
||||||
Dim attributes As New RADIUSAttributes
|
|
||||||
|
|
||||||
AccessLog("Checking for userHash " & sid)
|
|
||||||
|
|
||||||
If sid = state Then ' All good allow user access to the Web Interface
|
|
||||||
AccessLog("State and Sid match. Sending accept packet to Netscaler")
|
|
||||||
If existProxyState = True Then
|
|
||||||
attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
|
|
||||||
End If
|
|
||||||
|
|
||||||
|
|
||||||
Dim sGUID As String
|
|
||||||
sGUID = System.Guid.NewGuid.ToString()
|
|
||||||
|
|
||||||
' Add the user and guid to the access master list. This hash will be chech each time an application is launched. This prevents access through TS gateway without going through the Webinterface first.
|
|
||||||
|
|
||||||
If TSGWSessionIdHash.Contains(UserDomain) Then
|
|
||||||
TSGWSessionIdHash(UserDomain) = sGUID
|
|
||||||
Else
|
|
||||||
TSGWSessionIdHash.Add(UserDomain, sGUID)
|
|
||||||
End If
|
|
||||||
|
|
||||||
If TSGWSessionIdTimeStampHash.Contains(UserDomain) Then
|
|
||||||
TSGWSessionIdTimeStampHash(UserDomain) = Now
|
|
||||||
Else
|
|
||||||
TSGWSessionIdTimeStampHash.Add(UserDomain, Now)
|
|
||||||
End If
|
|
||||||
|
|
||||||
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
|
|
||||||
attributes.Add(guidAttribute)
|
|
||||||
packet.AcceptAccessRequest(attributes)
|
|
||||||
Else
|
|
||||||
packet.RejectAccessRequest()
|
|
||||||
End If
|
|
||||||
|
|
||||||
If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then ' Clean first login hash table
|
|
||||||
TSGWFirstLoginTimeStampHash.Remove(UserDomain)
|
|
||||||
TSGWFirstLoginHash.Remove(UserDomain)
|
|
||||||
End If
|
|
||||||
|
|
||||||
Else ' process the first login (sending sms token)
|
|
||||||
'Now lets get some information from ad if password is valid
|
|
||||||
Dim success As Boolean = False
|
|
||||||
Dim UserDomain As String = ""
|
|
||||||
'lets see if user login using upd or UPN name
|
|
||||||
Dim sUserName As String = username.ToString.ToLower
|
|
||||||
Dim sPassword As String = packet.UserPassword
|
|
||||||
If InStr(sUserName, "@") > 0 Then 'UPN
|
|
||||||
UserDomain = sUserName
|
|
||||||
Else 'UPD
|
|
||||||
'read domain from Hashtable
|
|
||||||
' UserDomain = NetBiosDomain & "\" & sUserName
|
|
||||||
UserDomain = sUserName
|
|
||||||
End If
|
|
||||||
|
|
||||||
AccessLog("User " & UserDomain & " is trying to log in ...")
|
|
||||||
|
|
||||||
Try
|
|
||||||
Dim dirEntry As New DirectoryEntry("LDAP://" & LDAPDomain, UserDomain, sPassword)
|
|
||||||
|
|
||||||
Dim obj As Object = dirEntry.NativeObject
|
|
||||||
Dim search As New DirectorySearcher(dirEntry)
|
|
||||||
|
|
||||||
If InStr(sUserName, "@") > 0 Then
|
|
||||||
search.Filter = "(userPrincipalName=" + sUserName + ")"
|
|
||||||
Else
|
|
||||||
search.Filter = "(SAMAccountName=" + Split(sUserName, "\")(1) + ")"
|
|
||||||
End If
|
|
||||||
'Load the Properties we need from AD
|
|
||||||
search.PropertiesToLoad.Add("distinguishedName")
|
|
||||||
'search.PropertiesToLoad.Add("primaryTelexNumber")
|
|
||||||
If EnableOTP = True Then
|
|
||||||
search.PropertiesToLoad.Add(ADField)
|
|
||||||
search.PropertiesToLoad.Add(ADMailField)
|
|
||||||
End If
|
|
||||||
' Time to find out if user entered the correct username and pasword
|
|
||||||
AccessLog("Authenticating: LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain)
|
|
||||||
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!)
|
|
||||||
'Dim code As String = DirectCast(result.Properties("primaryTelexNumber")(0), String)
|
|
||||||
'Dim aCode As String() = code.Split("/")
|
|
||||||
|
|
||||||
'Dim userLdap As String = "LDAP://" & LDAPPath & "/" & result.Properties("distinguishedName")(0)
|
|
||||||
'Dim userEntry As New DirectoryEntry(userLdap, UserDomain, sPassword)
|
|
||||||
If EnableOTP = True Then
|
|
||||||
' smsCode = GenerateCode()
|
|
||||||
|
|
||||||
' REMEMBER to put at check for empty phone string
|
|
||||||
Try
|
|
||||||
If EnableSMS = True Then
|
|
||||||
mobile = DirectCast(result.Properties(ADField)(0), String)
|
|
||||||
mobile = Replace(mobile, "+", "")
|
|
||||||
If mobile.Trim.Length = 0 Then
|
|
||||||
success = False
|
|
||||||
AccessLog("Unable to find correct phone number for user " & UserDomain)
|
|
||||||
Else
|
|
||||||
success = True
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
If EnableEmail = True Then
|
|
||||||
email = DirectCast(result.Properties(ADMailField)(0), String)
|
|
||||||
|
|
||||||
If InStr(email, "@") = 0 Then
|
|
||||||
success = False
|
|
||||||
AccessLog("Unable to find correct email for user " & UserDomain)
|
|
||||||
Else
|
|
||||||
success = True
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
Catch
|
|
||||||
AccessLog("Unable to find correct phone number or email for user " & UserDomain)
|
|
||||||
success = False
|
|
||||||
End Try
|
|
||||||
|
|
||||||
|
|
||||||
' sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
|
|
||||||
Else
|
|
||||||
|
|
||||||
End If
|
|
||||||
' sid = UserDomain & "_" & smsCode
|
|
||||||
'userEntry.Properties("primaryTelexNumber").Value = aCode(0) & "/" & smsCode & "/" & aCode(2) & "/" & aCode(3)
|
|
||||||
'userEntry.CommitChanges()
|
|
||||||
'userEntry.Dispose()
|
|
||||||
If 1 = 1 Then ' check if smscode is disabled for the user (Need to write this code)
|
|
||||||
'If userHash.ContainsKey(sid) Then
|
|
||||||
' userHash(sid) = sPassword
|
|
||||||
' If DEBUG = True Then
|
|
||||||
' AccessLog("Updating userHash " & sid)
|
|
||||||
' End If
|
|
||||||
'Else
|
|
||||||
' userHash.Add(sid, sPassword)
|
|
||||||
' If DEBUG = True Then
|
|
||||||
' AccessLog("Adding userHash " & sid)
|
|
||||||
' End If
|
|
||||||
'End If
|
|
||||||
' new code stored in AD now send it to the users phone
|
|
||||||
' Console.WriteLine(smsCode)
|
|
||||||
|
|
||||||
success = True
|
|
||||||
Else
|
|
||||||
success = False
|
|
||||||
End If
|
|
||||||
Catch
|
|
||||||
AccessLog("Failed to authenticate user against Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
|
|
||||||
success = False
|
|
||||||
End Try
|
|
||||||
|
|
||||||
|
|
||||||
Dim attributes As New RADIUSAttributes
|
|
||||||
If success Then ' Yay! Someone guess the password ...
|
|
||||||
Dim sendType As String = ""
|
|
||||||
AccessLog("User " & UserDomain & " authenticated against Active Directory")
|
|
||||||
If EnableOTP = True Then
|
|
||||||
If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then
|
|
||||||
Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
|
|
||||||
For Each atts As RADIUSAttribute In VSAtts
|
|
||||||
|
|
||||||
Dim opt As String = atts.GetVendorSpecific.VendorValue.ToString
|
|
||||||
|
|
||||||
Select Case UCase(opt)
|
|
||||||
Case "SMS"
|
|
||||||
sendType = "SMS"
|
|
||||||
Case "EMAIL"
|
|
||||||
sendType = "EMAIL"
|
|
||||||
End Select
|
|
||||||
Next
|
|
||||||
Else
|
|
||||||
sendType = "SMS"
|
|
||||||
End If
|
|
||||||
|
|
||||||
If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then
|
|
||||||
Dim hTime As DateTime = DirectCast(TSGWFirstLoginTimeStampHash(UserDomain), DateTime)
|
|
||||||
Dim tValid = DateDiff(DateInterval.Second, hTime, Now)
|
|
||||||
If tValid >= 5 Then
|
|
||||||
TSGWFirstLoginTimeStampHash.Remove(UserDomain)
|
|
||||||
TSGWFirstLoginHash.Remove(UserDomain)
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
If TSGWFirstLoginHash.Contains(UserDomain) Then
|
|
||||||
sid = TSGWFirstLoginHash(UserDomain).ToString
|
|
||||||
AccessLog("Access token already send to phonenumber " & mobile)
|
|
||||||
Else
|
|
||||||
smsCode = GenerateCode()
|
|
||||||
sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
|
|
||||||
AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
|
|
||||||
TSGWFirstLoginHash.Add(UserDomain, sid)
|
|
||||||
TSGWFirstLoginTimeStampHash.Add(UserDomain, Now)
|
|
||||||
|
|
||||||
|
|
||||||
If sendType = "SMS" Then
|
|
||||||
Call SendSMS(mobile, smsCode)
|
|
||||||
Else
|
|
||||||
Call SendEmail(email, smsCode)
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
|
|
||||||
Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid)
|
|
||||||
|
|
||||||
attributes.Add(attr)
|
|
||||||
attributes.Add(state)
|
|
||||||
|
|
||||||
packet.SendAccessChallenge(attributes)
|
|
||||||
|
|
||||||
Else ' One time Password not enabled, so we let the user in
|
|
||||||
' add session key so user can access applications.
|
|
||||||
|
|
||||||
Dim sGUID As String
|
|
||||||
sGUID = System.Guid.NewGuid.ToString()
|
|
||||||
If TSGWSessionIdHash.Contains(UserDomain) Then
|
|
||||||
TSGWSessionIdHash(UserDomain) = sGUID
|
|
||||||
Else
|
|
||||||
TSGWSessionIdHash.Add(UserDomain, sGUID)
|
|
||||||
End If
|
|
||||||
|
|
||||||
If TSGWSessionIdTimeStampHash.Contains(UserDomain) Then
|
|
||||||
TSGWSessionIdTimeStampHash(UserDomain) = Now
|
|
||||||
Else
|
|
||||||
TSGWSessionIdTimeStampHash.Add(UserDomain, Now)
|
|
||||||
End If
|
|
||||||
|
|
||||||
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
|
|
||||||
|
|
||||||
attributes.Add(guidAttribute)
|
|
||||||
packet.AcceptAccessRequest(attributes)
|
|
||||||
End If
|
|
||||||
' packetHash.Remove(username.GetString & "_" & pass.GetString)
|
|
||||||
Else
|
|
||||||
AccessLog("User " & UserDomain & " failed to authenticate against Active Directory")
|
|
||||||
packet.RejectAccessRequest()
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
End If
|
|
||||||
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Public Shared Function GenerateCode() As String
|
Public Shared Function GenerateCode() As String
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -80,6 +80,7 @@
|
||||||
<Compile Include="Conversion.vb" />
|
<Compile Include="Conversion.vb" />
|
||||||
<Compile Include="exceptions\MissingRadiusSecret.vb" />
|
<Compile Include="exceptions\MissingRadiusSecret.vb" />
|
||||||
<Compile Include="exceptions\MissingUser.vb" />
|
<Compile Include="exceptions\MissingUser.vb" />
|
||||||
|
<Compile Include="handlers\CitrixHandler.vb" />
|
||||||
<Compile Include="handlers\RDSHandler.vb" />
|
<Compile Include="handlers\RDSHandler.vb" />
|
||||||
<Compile Include="VendorSpefic.vb" />
|
<Compile Include="VendorSpefic.vb" />
|
||||||
<Compile Include="Crypto.vb" />
|
<Compile Include="Crypto.vb" />
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue