mirror of
https://github.com/jakobadam/RDSFactor.git
synced 2025-06-11 06:54:29 +02:00
Moved Citrix handler to separate class
This commit is contained in:
parent
9d50d9ca7c
commit
fd9c8db357
3 changed files with 282 additions and 274 deletions
|
@ -14,30 +14,32 @@ Public Class CICRadarR
|
||||||
Public Shared LDAPDomain As String = ""
|
Public Shared LDAPDomain As String = ""
|
||||||
Public Shared ADField As String = ""
|
Public Shared ADField As String = ""
|
||||||
Public Shared ADMailField As String = ""
|
Public Shared ADMailField As String = ""
|
||||||
|
Public Shared EnableOTP As Boolean
|
||||||
' TODO: What this?
|
' TODO: What this?
|
||||||
Public Shared encCode As String = "gewsyy#sjs2!"
|
Public Shared encCode As String = "gewsyy#sjs2!"
|
||||||
|
|
||||||
Private DEBUG As Boolean
|
Private Shared DEBUG As Boolean
|
||||||
Public Shared EnableOTP As Boolean
|
|
||||||
Private Log As New LogWriter
|
Private Shared UserAccessLog As New LogWriter
|
||||||
Private UserAccessLog As New LogWriter
|
Private Shared Log As New LogWriter
|
||||||
|
|
||||||
Private secrets As NASAuthList
|
Private secrets As NASAuthList
|
||||||
Private radius1812 As RADIUSServer
|
Private radius1812 As RADIUSServer
|
||||||
Private radius1645 As RADIUSServer
|
Private radius1645 As RADIUSServer
|
||||||
Private userHash As New Hashtable
|
Private userHash As New Hashtable
|
||||||
Private packetHash As New Hashtable
|
Private packetHash As New Hashtable
|
||||||
Private clientHash As New Hashtable
|
Private clientHash As New Hashtable
|
||||||
Private NetBiosDomain As String = ""
|
|
||||||
|
|
||||||
Private Provider As String = ""
|
Public Shared NetBiosDomain As String = ""
|
||||||
|
|
||||||
|
Private Shared Provider As String = ""
|
||||||
|
|
||||||
|
|
||||||
Private ModemType As String = ""
|
Private Shared ModemType As String = ""
|
||||||
Private ComPort As String = ""
|
Private Shared ComPort As String = ""
|
||||||
Private SmsC As String = ""
|
Private Shared SmsC As String = ""
|
||||||
Private MailServer As String = ""
|
Private Shared MailServer As String = ""
|
||||||
Private SenderEmail As String = ""
|
Private Shared SenderEmail As String = ""
|
||||||
|
|
||||||
Private TSGW As String = ""
|
Private TSGW As String = ""
|
||||||
Private TSGWSessionIdHash As New Hashtable
|
Private TSGWSessionIdHash As New Hashtable
|
||||||
|
@ -45,11 +47,11 @@ Public Class CICRadarR
|
||||||
Private TSGWLaunchIdTimeStampHash 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 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.
|
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
|
||||||
Private EnableSMS As Boolean = False
|
Public Shared EnableSMS As Boolean = False
|
||||||
Private EnableEmail As Boolean = False
|
Public Shared EnableEmail As Boolean = False
|
||||||
|
|
||||||
|
|
||||||
Protected Overrides Sub OnStart(ByVal args() As String)
|
Protected Overrides Sub OnStart(ByVal args() As String)
|
||||||
|
|
||||||
|
@ -125,13 +127,13 @@ Public Class CICRadarR
|
||||||
ProcessPacket(radius1645, packet)
|
ProcessPacket(radius1645, packet)
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub AccessLog(ByVal message)
|
Public Shared Sub AccessLog(ByVal message)
|
||||||
If DEBUG = True Then
|
If DEBUG = True Then
|
||||||
UserAccessLog.WriteLog(Now & ": DEBUG: " & message)
|
UserAccessLog.WriteLog(Now & ": DEBUG: " & message)
|
||||||
End If
|
End If
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub ServerLog(ByVal message)
|
Public Shared Sub ServerLog(ByVal message)
|
||||||
Log.WriteLog(Now & ":" & message)
|
Log.WriteLog(Now & ":" & message)
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
@ -141,18 +143,14 @@ Public Class CICRadarR
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim muuh As New VendorSpecificAttribute(VendorSpecificType.Generic, "LAUNCH")
|
Dim handler
|
||||||
Dim atts As New RADIUSAttributes
|
|
||||||
|
|
||||||
muuh.SetRADIUSAttribute(atts)
|
|
||||||
|
|
||||||
If TSGW = "1" Then
|
If TSGW = "1" Then
|
||||||
Dim rds As New RDSHandler(packet)
|
handler = New RDSHandler(packet)
|
||||||
rds.ProcessRequest()
|
|
||||||
'ProcessPacketTSGW(server, packet)
|
|
||||||
Else
|
Else
|
||||||
ProcessPacketCSG(server, packet)
|
handler = New CitrixHandler(packet)
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
handler.ProcessRequest()
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
@ -559,248 +557,6 @@ Public Class CICRadarR
|
||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Private Sub ProcessPacketCSG(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
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
' 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)
|
|
||||||
Dim sid As String = ""
|
|
||||||
Dim mobile As String = ""
|
|
||||||
Dim smsCode As String = ""
|
|
||||||
Dim UserEmail 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 pressent.. Drop!")
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
|
|
||||||
AccessLog("Processing packet for user: " & username.ToString)
|
|
||||||
|
|
||||||
'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then
|
|
||||||
' Exit Sub
|
|
||||||
'End If
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
|
|
||||||
AccessLog("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
|
|
||||||
AccessLog("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
|
|
||||||
|
|
||||||
AccessLog("SMSToken supplied by user: " & sUserName)
|
|
||||||
|
|
||||||
sid = ""
|
|
||||||
If InStr(sUserName, "@") > 0 Then 'UPN
|
|
||||||
UserDomain = sUserName
|
|
||||||
Else 'UPD
|
|
||||||
'read domain from Hashtable
|
|
||||||
UserDomain = NetBiosDomain & "\" & sUserName
|
|
||||||
End If
|
|
||||||
|
|
||||||
sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode)
|
|
||||||
AccessLog("Checking for userHash " & sid)
|
|
||||||
If sid = state Then
|
|
||||||
packet.AcceptAccessRequest()
|
|
||||||
Else
|
|
||||||
packet.RejectAccessRequest()
|
|
||||||
End If
|
|
||||||
Else ' process the first login
|
|
||||||
|
|
||||||
' packetHash.Add(username.GetString & "_" & pass.GetString, 0)
|
|
||||||
|
|
||||||
' Console.WriteLine(username.GetString & " is trying to log in ... ")
|
|
||||||
' Note that an attribute can represent a string, number, IP, etc.
|
|
||||||
' RADAR will not guess that automatically, so use the appropriate
|
|
||||||
' function according to the attribute you're trying to read. Otherwise,
|
|
||||||
' the Value property is just a bunch of bytes as received in the
|
|
||||||
' RADIUS packet.
|
|
||||||
|
|
||||||
|
|
||||||
'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
|
|
||||||
Dim sPassword As String = packet.UserPassword
|
|
||||||
If InStr(sUserName, "@") > 0 Then 'UPN
|
|
||||||
UserDomain = sUserName
|
|
||||||
Else 'UPD
|
|
||||||
'read domain from Hashtable
|
|
||||||
UserDomain = NetBiosDomain & "\" & 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=" + sUserName + ")"
|
|
||||||
End If
|
|
||||||
'Load the Properties we need from AD
|
|
||||||
search.PropertiesToLoad.Add("distinguishedName")
|
|
||||||
'search.PropertiesToLoad.Add("primaryTelexNumber")
|
|
||||||
If EnableOTP = True Then
|
|
||||||
If EnableEmail = True Then
|
|
||||||
search.PropertiesToLoad.Add(ADMailField)
|
|
||||||
End If
|
|
||||||
If EnableSMS = True Then
|
|
||||||
search.PropertiesToLoad.Add(ADField)
|
|
||||||
End If
|
|
||||||
|
|
||||||
End If
|
|
||||||
' Time to find out if user entered the correct username and pasword
|
|
||||||
AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & 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!)
|
|
||||||
'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
|
|
||||||
If EnableEmail = True Then
|
|
||||||
Try
|
|
||||||
UserEmail = DirectCast(result.Properties(ADMailField)(0), String)
|
|
||||||
|
|
||||||
If UserEmail.Trim.Length = 0 Or InStr(UserEmail, "@") = 0 Then
|
|
||||||
success = False
|
|
||||||
AccessLog("Unable to find correct email for user " & UserDomain)
|
|
||||||
Else
|
|
||||||
success = True
|
|
||||||
End If
|
|
||||||
Catch
|
|
||||||
AccessLog("Unable to find correct email for user " & UserDomain)
|
|
||||||
success = False
|
|
||||||
End Try
|
|
||||||
End If
|
|
||||||
If EnableSMS = True Then
|
|
||||||
Try
|
|
||||||
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
|
|
||||||
Catch
|
|
||||||
AccessLog("Unable to find correct phone number for user " & UserDomain)
|
|
||||||
success = False
|
|
||||||
End Try
|
|
||||||
|
|
||||||
End If
|
|
||||||
|
|
||||||
sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
|
|
||||||
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 agains 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 ...
|
|
||||||
|
|
||||||
AccessLog("User " & UserDomain & " authenticated agains Active Directory")
|
|
||||||
If EnableOTP = True Then
|
|
||||||
Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
|
|
||||||
attributes.Add(attr)
|
|
||||||
Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid)
|
|
||||||
attributes.Add(state)
|
|
||||||
' Console.WriteLine("len " & packet.Authenticator.Length.ToString)
|
|
||||||
server.SendAsResponse( _
|
|
||||||
New RADIUSPacket(RadiusPacketCode.AccessChallenge, _
|
|
||||||
packet.Identifier, attributes, _
|
|
||||||
packet.EndPoint), _
|
|
||||||
packet.Authenticator)
|
|
||||||
If EnableSMS = True Then
|
|
||||||
AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
|
|
||||||
Call SendSMS(mobile, smsCode)
|
|
||||||
End If
|
|
||||||
If EnableEmail = True Then
|
|
||||||
AccessLog("Sending access token: " & smsCode & " to email " & UserEmail)
|
|
||||||
Call SendEmail(UserEmail, smsCode)
|
|
||||||
End If
|
|
||||||
Else
|
|
||||||
AccessLog("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 ...
|
|
||||||
|
|
||||||
AccessLog("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
|
|
||||||
' to the response, you can sepcify Nothing instead of
|
|
||||||
' creating an empty RADIUSAttributes object.
|
|
||||||
' packetHash.Remove(username.GetString & "_" & pass.GetString)
|
|
||||||
End If
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
End If
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Public Shared Function GenerateCode() As String
|
Public Shared Function GenerateCode() As String
|
||||||
|
|
||||||
|
|
||||||
|
@ -910,7 +666,7 @@ Public Class CICRadarR
|
||||||
Return Path.GetDirectoryName([Assembly].GetExecutingAssembly().Location)
|
Return Path.GetDirectoryName([Assembly].GetExecutingAssembly().Location)
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function SendSMS(ByVal number As String, ByVal passcode As String) As String
|
Public Shared Function SendSMS(ByVal number As String, ByVal passcode As String) As String
|
||||||
|
|
||||||
' test if using online sms provider or local modem
|
' test if using online sms provider or local modem
|
||||||
If ModemType = 1 Then ' local modem
|
If ModemType = 1 Then ' local modem
|
||||||
|
@ -957,7 +713,7 @@ Public Class CICRadarR
|
||||||
|
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Public Function SendEmail(email As String, passcode As String) As String
|
Public Shared Function SendEmail(email As String, passcode As String) As String
|
||||||
|
|
||||||
|
|
||||||
Dim mail As New MailMessage()
|
Dim mail As New MailMessage()
|
||||||
|
|
251
CICRadarR/handlers/CitrixHandler.vb
Normal file
251
CICRadarR/handlers/CitrixHandler.vb
Normal file
|
@ -0,0 +1,251 @@
|
||||||
|
Imports System.DirectoryServices
|
||||||
|
|
||||||
|
' TODO: I don't use this! It's a leftover, moved out of the way
|
||||||
|
' from the CICRadarR.vb
|
||||||
|
'
|
||||||
|
' Look in RDSHandler how this should be refactored.
|
||||||
|
Public Class CitrixHandler
|
||||||
|
|
||||||
|
Public Sub New(packet As RADIUSPacket)
|
||||||
|
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Private Sub ProcessPacketCSG(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
|
||||||
|
CICRadarR.AccessLog("Not a valid radius packet.. Drop!")
|
||||||
|
Exit Sub
|
||||||
|
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)
|
||||||
|
Dim sid As String = ""
|
||||||
|
Dim mobile As String = ""
|
||||||
|
Dim smsCode As String = ""
|
||||||
|
Dim UserEmail 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.
|
||||||
|
CICRadarR.AccessLog("Not a valid radius packet.. No username pressent.. Drop!")
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
CICRadarR.AccessLog("Processing packet for user: " & username.ToString)
|
||||||
|
|
||||||
|
'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then
|
||||||
|
' Exit Sub
|
||||||
|
'End If
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
|
||||||
|
CICRadarR.AccessLog("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
|
||||||
|
CICRadarR.AccessLog("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
|
||||||
|
|
||||||
|
CICRadarR.AccessLog("SMSToken supplied by user: " & sUserName)
|
||||||
|
|
||||||
|
sid = ""
|
||||||
|
If InStr(sUserName, "@") > 0 Then 'UPN
|
||||||
|
UserDomain = sUserName
|
||||||
|
Else 'UPD
|
||||||
|
'read domain from Hashtable
|
||||||
|
UserDomain = CICRadarR.NetBiosDomain & "\" & sUserName
|
||||||
|
End If
|
||||||
|
|
||||||
|
sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, CICRadarR.encCode)
|
||||||
|
CICRadarR.AccessLog("Checking for userHash " & sid)
|
||||||
|
If sid = state Then
|
||||||
|
packet.AcceptAccessRequest()
|
||||||
|
Else
|
||||||
|
packet.RejectAccessRequest()
|
||||||
|
End If
|
||||||
|
Else ' process the first login
|
||||||
|
|
||||||
|
' packetHash.Add(username.GetString & "_" & pass.GetString, 0)
|
||||||
|
|
||||||
|
' Console.WriteLine(username.GetString & " is trying to log in ... ")
|
||||||
|
' Note that an attribute can represent a string, number, IP, etc.
|
||||||
|
' RADAR will not guess that automatically, so use the appropriate
|
||||||
|
' function according to the attribute you're trying to read. Otherwise,
|
||||||
|
' the Value property is just a bunch of bytes as received in the
|
||||||
|
' RADIUS packet.
|
||||||
|
|
||||||
|
|
||||||
|
'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
|
||||||
|
Dim sPassword As String = packet.UserPassword
|
||||||
|
If InStr(sUserName, "@") > 0 Then 'UPN
|
||||||
|
UserDomain = sUserName
|
||||||
|
Else 'UPD
|
||||||
|
'read domain from Hashtable
|
||||||
|
UserDomain = CICRadarR.NetBiosDomain & "\" & sUserName
|
||||||
|
End If
|
||||||
|
|
||||||
|
CICRadarR.AccessLog("User " & UserDomain & " is trying to log in ...")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Try
|
||||||
|
Dim dirEntry As New DirectoryEntry("LDAP://" & CICRadarR.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=" + sUserName + ")"
|
||||||
|
End If
|
||||||
|
'Load the Properties we need from AD
|
||||||
|
search.PropertiesToLoad.Add("distinguishedName")
|
||||||
|
'search.PropertiesToLoad.Add("primaryTelexNumber")
|
||||||
|
If CICRadarR.EnableOTP = True Then
|
||||||
|
If CICRadarR.EnableEmail = True Then
|
||||||
|
search.PropertiesToLoad.Add(CICRadarR.ADMailField)
|
||||||
|
End If
|
||||||
|
If CICRadarR.EnableSMS = True Then
|
||||||
|
search.PropertiesToLoad.Add(CICRadarR.ADField)
|
||||||
|
End If
|
||||||
|
|
||||||
|
End If
|
||||||
|
' Time to find out if user entered the correct username and pasword
|
||||||
|
CICRadarR.AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & CICRadarR.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!)
|
||||||
|
'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 CICRadarR.EnableOTP = True Then
|
||||||
|
smsCode = CICRadarR.GenerateCode()
|
||||||
|
|
||||||
|
' REMEMBER to put at check for empty phone string
|
||||||
|
If CICRadarR.EnableEmail = True Then
|
||||||
|
Try
|
||||||
|
UserEmail = DirectCast(result.Properties(CICRadarR.ADMailField)(0), String)
|
||||||
|
|
||||||
|
If UserEmail.Trim.Length = 0 Or InStr(UserEmail, "@") = 0 Then
|
||||||
|
success = False
|
||||||
|
CICRadarR.AccessLog("Unable to find correct email for user " & UserDomain)
|
||||||
|
Else
|
||||||
|
success = True
|
||||||
|
End If
|
||||||
|
Catch
|
||||||
|
CICRadarR.AccessLog("Unable to find correct email for user " & UserDomain)
|
||||||
|
success = False
|
||||||
|
End Try
|
||||||
|
End If
|
||||||
|
If CICRadarR.EnableSMS = True Then
|
||||||
|
Try
|
||||||
|
mobile = DirectCast(result.Properties(CICRadarR.ADField)(0), String)
|
||||||
|
mobile = Replace(mobile, "+", "")
|
||||||
|
If mobile.Trim.Length = 0 Then
|
||||||
|
success = False
|
||||||
|
CICRadarR.AccessLog("Unable to find correct phone number for user " & UserDomain)
|
||||||
|
Else
|
||||||
|
success = True
|
||||||
|
End If
|
||||||
|
Catch
|
||||||
|
CICRadarR.AccessLog("Unable to find correct phone number for user " & UserDomain)
|
||||||
|
success = False
|
||||||
|
End Try
|
||||||
|
|
||||||
|
End If
|
||||||
|
|
||||||
|
sid = EncDec.Encrypt(UserDomain & "_" & smsCode, CICRadarR.encCode) 'generate unique code
|
||||||
|
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
|
||||||
|
' CICRadarR.AccessLog("Updating userHash " & sid)
|
||||||
|
' End If
|
||||||
|
'Else
|
||||||
|
' userHash.Add(sid, sPassword)
|
||||||
|
' If DEBUG = True Then
|
||||||
|
' CICRadarR.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
|
||||||
|
CICRadarR.AccessLog("Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & CICRadarR.LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
|
||||||
|
success = False
|
||||||
|
End Try
|
||||||
|
|
||||||
|
|
||||||
|
Dim attributes As New RADIUSAttributes
|
||||||
|
If success Then ' Yay! Someone guess the password ...
|
||||||
|
|
||||||
|
CICRadarR.AccessLog("User " & UserDomain & " authenticated agains Active Directory")
|
||||||
|
If CICRadarR.EnableOTP = True Then
|
||||||
|
Dim attr As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, "SMS Token")
|
||||||
|
attributes.Add(attr)
|
||||||
|
Dim state As New RADIUSAttribute(RadiusAttributeType.State, sid)
|
||||||
|
attributes.Add(state)
|
||||||
|
' Console.WriteLine("len " & packet.Authenticator.Length.ToString)
|
||||||
|
server.SendAsResponse( _
|
||||||
|
New RADIUSPacket(RadiusPacketCode.AccessChallenge, _
|
||||||
|
packet.Identifier, attributes, _
|
||||||
|
packet.EndPoint), _
|
||||||
|
packet.Authenticator)
|
||||||
|
If CICRadarR.EnableSMS = True Then
|
||||||
|
CICRadarR.AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
|
||||||
|
Call CICRadarR.SendSMS(mobile, smsCode)
|
||||||
|
End If
|
||||||
|
If CICRadarR.EnableEmail = True Then
|
||||||
|
CICRadarR.AccessLog("Sending access token: " & smsCode & " to email " & UserEmail)
|
||||||
|
Call CICRadarR.SendEmail(UserEmail, smsCode)
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
CICRadarR.AccessLog("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 ...
|
||||||
|
|
||||||
|
CICRadarR.AccessLog("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
|
||||||
|
' to the response, you can sepcify Nothing instead of
|
||||||
|
' creating an empty RADIUSAttributes object.
|
||||||
|
' packetHash.Remove(username.GetString & "_" & pass.GetString)
|
||||||
|
End If
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
End If
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
|
||||||
|
End Class
|
|
@ -209,9 +209,11 @@ Public Class RDSHandler
|
||||||
tokenTimestamps(mUsername) = Now
|
tokenTimestamps(mUsername) = Now
|
||||||
|
|
||||||
If mUseSMSFactor Then
|
If mUseSMSFactor Then
|
||||||
Console.WriteLine("SMS: ")
|
Console.WriteLine("TODO: Send SMS")
|
||||||
ElseIf mUseEmailFactor Then
|
End If
|
||||||
Console.WriteLine("Email: ")
|
|
||||||
|
If mUseEmailFactor Then
|
||||||
|
Console.WriteLine("TODO: Send Email")
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim attributes As New RADIUSAttributes
|
Dim attributes As New RADIUSAttributes
|
||||||
|
@ -230,7 +232,6 @@ Public Class RDSHandler
|
||||||
Dim ldapDomain As String = CICRadarR.LDAPDomain
|
Dim ldapDomain As String = CICRadarR.LDAPDomain
|
||||||
|
|
||||||
Console.WriteLine("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & mUsername)
|
Console.WriteLine("Authenticating: LDAPPAth: " & "LDAP://" & ldapDomain & ", Username: " & mUsername)
|
||||||
Console.WriteLine("Passowrd: " & password)
|
|
||||||
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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue