zydronium/RDSFactor
1
0
Fork 0
mirror of https://github.com/jakobadam/RDSFactor.git synced 2025-08-12 19:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity

Simplify. Reduce all 3 line debug stms. to one.

Browse source
This commit is contained in:
Jakob A. Dam 2015-03-27 13:15:10 +01:00 • committed by Jakob Aarøe Dam
parent 3402587bae
commit d7d04258e1
1 changed files with 116 additions and 217 deletions
Download patch file Download diff file Expand all files Collapse all files

333
CICRadarR/CICRadarR.vb
View file

@ -8,6 +8,7 @@ Imports System.Text
Imports System Imports System
Imports System.Net.Mail Imports System.Net.Mail
Public Class CICRadarR Public Class CICRadarR
Private DEBUG As Boolean Private DEBUG As Boolean
@ -128,7 +129,32 @@ Public Class CICRadarR
ProcessPacket(radius1645, packet) ProcessPacket(radius1645, packet)
End Sub End Sub
Private Sub AccessLog(ByVal message)
If DEBUG = True Then
UserAccessLog.WriteLog(Now & ": DEBUG: " & message)
End If
End Sub
Private Sub RadiusAccept(ByVal server As RADIUSServer,
ByVal packet As RADIUSPacket,
ByVal attributes As RADIUSAttributes
)
AccessLog("Radius Accept")
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessAccept, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End Sub
Private Sub RadiusReject(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket, ByVal attributes As RADIUSAttributes)
AccessLog("Radius Reject")
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessReject, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End Sub
Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket) Private Sub ProcessPacket(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)
Dim muuh As New VendorSpecificAttribute(VendorSpecificType.Generic, "LAUNCH") Dim muuh As New VendorSpecificAttribute(VendorSpecificType.Generic, "LAUNCH")
@ -155,7 +181,7 @@ Public Class CICRadarR
ProcessPacketCSG(server, packet) ProcessPacketCSG(server, packet)
End If End If
End Sub End Sub
Sub ProcessPacketTSGW(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket) Sub ProcessPacketTSGW(ByVal server As RADIUSServer, ByVal packet As RADIUSPacket)
@ -163,15 +189,10 @@ Public Class CICRadarR
' and drop other requests silently ... ' and drop other requests silently ...
If packet.Code <> RadiusPacketCode.AccessRequest Then If packet.Code <> RadiusPacketCode.AccessRequest Then
If DEBUG = True Then AccessLog("Not a valid radius packet.. Drop!")
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. Drop!")
End If
Exit Sub Exit Sub
Else Else
If DEBUG = True Then AccessLog("Radius packet recived")
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Radius packet recived")
End If
End If End If
Dim LaunchApp As String = "" Dim LaunchApp As String = ""
@ -207,87 +228,74 @@ Public Class CICRadarR
Dim pass As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserPassword) Dim pass As RADIUSAttribute = packet.Attributes.GetFirstAttribute(RadiusAttributeType.UserPassword)
If LaunchApp = "LAUNCH" Then ' handle RadiusSession when application launches. Store it and check when connection is made through TS Gateway If LaunchApp = "LAUNCH" Then
Dim sRadiusSessionId = packet.UserPassword Dim sRadiusSessionId = packet.UserPassword
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
Dim SessionId_Ok As Boolean = False Dim SessionId_Ok As Boolean = False
Dim sUserName As String = username.GetString.ToLower Dim sUserName As String = username.GetString.ToLower
If TSGWSessionIdHash.Contains(sUserName) And TSGWSessionIdTimeStampHash.Contains(sUserName) Then ' user has a session lets check if it valid AccessLog("RDWeb app launch: Checking token validity for user: " & sUserName)
If TSGWSessionIdHash.Contains(sUserName) And TSGWSessionIdTimeStampHash.Contains(sUserName) Then
Dim hashTime As DateTime = DirectCast(TSGWSessionIdTimeStampHash(sUserName), DateTime) Dim hashTime As DateTime = DirectCast(TSGWSessionIdTimeStampHash(sUserName), DateTime)
Dim tValid = DateDiff(DateInterval.Minute, hashTime, Now) Dim tValid = DateDiff(DateInterval.Minute, hashTime, Now)
If tValid < SessionTimeOut Then If tValid < SessionTimeOut Then
' check session id ' check session id
If sRadiusSessionId = DirectCast(TSGWSessionIdHash(sUserName), String) Then ' Session id match If sRadiusSessionId = DirectCast(TSGWSessionIdHash(sUserName), String) Then ' Session id match
SessionId_Ok = True ' Session ok now add launch hash key SessionId_Ok = True
If TSGWLaunchIdTimeStampHash.Contains(sUserName) Then If TSGWLaunchIdTimeStampHash.Contains(sUserName) Then
TSGWLaunchIdTimeStampHash(sUserName) = Now TSGWLaunchIdTimeStampHash(sUserName) = Now
Else Else
TSGWLaunchIdTimeStampHash.Add(sUserName, Now) TSGWLaunchIdTimeStampHash.Add(sUserName, Now)
End If End If
Console.WriteLine(sUserName)
End If End If
End If End If
End If End If
If SessionId_Ok Then ' found match in hash table' Return ok If SessionId_Ok Then ' found match in hash table' Return ok
server.SendAsResponse( _ RadiusAccept(server, packet, attributes)
New RADIUSPacket(RadiusPacketCode.AccessAccept, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
Else Else
server.SendAsResponse( _ RadiusReject(server, packet, attributes)
New RADIUSPacket(RadiusPacketCode.AccessReject, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End If End If
ElseIf launchTSGW = "LAUNCH" Then
ElseIf launchTSGW = "LAUNCH" Then ' TSGateWay Connection
Dim sRadiusSessionId = packet.UserPassword Dim sRadiusSessionId = packet.UserPassword
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
Dim proxyState As String Dim proxyState As String
Dim LaunchId_Ok As Boolean = False Dim LaunchId_Ok As Boolean = False
Dim sUserName As String = username.GetString.ToLower Dim sUserName As String = username.GetString.ToLower
AccessLog("TSGateWay Connection checking token validity for user: " & sUserName)
Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState) Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
If existProxyState = True Then If existProxyState = True Then
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString
If DEBUG = True Then AccessLog("Packet contains a state attribute ProxyState=" & proxyState)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute ProxyState=" & proxyState)
End If
attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState)) attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
End If End If
'Check launchHash to see if user hash a valid launch window (default 30 sec.) 'Check launchHash to see if user hash a valid launch window (default 30 sec.)
Console.WriteLine(sUserName)
If TSGWLaunchIdTimeStampHash.Contains(sUserName) = True Then ' user has a launch id lets check if it valid 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 hashTime As DateTime = DirectCast(TSGWLaunchIdTimeStampHash(sUserName), DateTime)
Dim tValid = DateDiff(DateInterval.Second, hashTime, Now) Dim tValid = DateDiff(DateInterval.Second, hashTime, Now)
If tValid < LaunchTimeOut Then If tValid < LaunchTimeOut Then
AccessLog("User " & sUserName & " has valid token.")
LaunchId_Ok = True ' Launch ok now add launch hash key LaunchId_Ok = True ' Launch ok now add launch hash key
TSGWLaunchIdTimeStampHash.Remove(sUserName) TSGWLaunchIdTimeStampHash.Remove(sUserName)
Else
AccessLog("Token of " & sUserName & " timed out.")
End If End If
Else
AccessLog(sUserName & " has no entry in db.")
End If End If
If LaunchId_Ok Then ' found match in hash table' Return ok If LaunchId_Ok Then ' found match in hash table' Return ok
server.SendAsResponse( _ RadiusAccept(server, packet, attributes)
New RADIUSPacket(RadiusPacketCode.AccessAccept, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
Else Else
server.SendAsResponse( _ RadiusReject(server, packet, attributes)
New RADIUSPacket(RadiusPacketCode.AccessReject, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End If End If
Else Else
@ -302,52 +310,35 @@ Public Class CICRadarR
' 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.
If DEBUG = True Then AccessLog("Not a valid radius packet.. No username pressent.. Drop!")
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. No username pressent.. Drop!")
End If
Exit Sub Exit Sub
End If End If
If DEBUG = True Then AccessLog("Processing packet for user: " & username.GetString)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Processing packet for user: " & username.GetString)
End If
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State) Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState) Dim existProxyState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.ProxyState)
If DEBUG = True Then
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute? State=" & existState.ToString)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a proxy-state attribute? Proxy-State=" & existState.ToString)
End If
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) 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 state As String
Dim proxyState As String Dim proxyState As String
state = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).GetString state = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).GetString
If DEBUG = True Then AccessLog("Packet contains a state attribute State=" & state)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute State=" & state)
End If
If existProxyState = True Then If existProxyState = True Then
proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString proxyState = packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState).GetString
If DEBUG = True Then AccessLog("Packet contains a state attribute State=" & proxyState)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute State=" & proxyState)
End If
End If End If
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.GetString.ToLower Dim sUserName As String = username.GetString.ToLower
If DEBUG = True Then
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Username = " & sUserName)
End If
Dim sPassword As String = packet.UserPassword Dim sPassword As String = packet.UserPassword
If DEBUG = True Then
UserAccessLog.WriteLog(Now & ":" & "DEBUG: SMSToken supplied by the user = " & sPassword) AccessLog("SMSToken supplied by user: " & sUserName)
End If
sid = "" sid = ""
If InStr(sUserName, "@") > 0 Then 'UPN If InStr(sUserName, "@") > 0 Then 'UPN
UserDomain = sUserName UserDomain = sUserName
@ -359,14 +350,11 @@ Public Class CICRadarR
sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode) sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode)
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
If DEBUG = True Then
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Checking for userHash " & sid) AccessLog("Checking for userHash " & sid)
End If
If sid = state Then ' All good allow user access to the Web Interface If sid = state Then ' All good allow user access to the Web Interface
If DEBUG = True Then AccessLog("State and Sid match. Sending accept packet to Netscaler")
UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid match. Sending accept packet to Netscaler")
End If
If existProxyState = True Then If existProxyState = True Then
attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState)) attributes.Add(packet.Attributes.GetFirstAttribute(RadiusAttributeType.ProxyState))
End If End If
@ -393,25 +381,9 @@ Public Class CICRadarR
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID) Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
attributes.Add(guidAttribute) attributes.Add(guidAttribute)
' send accept packet to the user RadiusAccept(server, packet, attributes)
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessAccept, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has successfully authenticated with Token")
Else Else
If DEBUG = True Then RadiusReject(server, packet, attributes)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid does not match. Sending reject packet to Netscaler")
End If
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessReject, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has failed to authenticate. Incorrect Token")
End If End If
If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then ' Clean first login hash table If TSGWFirstLoginTimeStampHash.Contains(UserDomain) Then ' Clean first login hash table
@ -437,7 +409,7 @@ Public Class CICRadarR
UserDomain = sUserName UserDomain = sUserName
End If End If
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " is trying to log in ...") AccessLog("User " & UserDomain & " is trying to log in ...")
Try Try
@ -460,7 +432,7 @@ Public Class CICRadarR
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
If DEBUG = True Then If DEBUG = True Then
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword) AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
End If End If
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!)
@ -479,9 +451,7 @@ Public Class CICRadarR
mobile = Replace(mobile, "+", "") mobile = Replace(mobile, "+", "")
If mobile.Trim.Length = 0 Then If mobile.Trim.Length = 0 Then
success = False success = False
If DEBUG = True Then AccessLog("Unable to find correct phone number for user " & UserDomain)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number for user " & UserDomain)
End If
Else Else
success = True success = True
End If End If
@ -492,17 +462,13 @@ Public Class CICRadarR
If InStr(email, "@") = 0 Then If InStr(email, "@") = 0 Then
success = False success = False
If DEBUG = True Then AccessLog("Unable to find correct email for user " & UserDomain)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct email for user " & UserDomain)
End If
Else Else
success = True success = True
End If End If
End If End If
Catch Catch
If DEBUG = True Then AccessLog("Unable to find correct phone number or email for user " & UserDomain)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number or email for user " & UserDomain)
End If
success = False success = False
End Try End Try
@ -519,12 +485,12 @@ Public Class CICRadarR
'If userHash.ContainsKey(sid) Then 'If userHash.ContainsKey(sid) Then
' userHash(sid) = sPassword ' userHash(sid) = sPassword
' If DEBUG = True Then ' If DEBUG = True Then
' UserAccessLog.WriteLog(Now & ":" & "DEBUG: Updating userHash " & sid) ' AccessLog("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
' UserAccessLog.WriteLog(Now & ":" & "DEBUG: Adding userHash " & sid) ' AccessLog("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
@ -535,9 +501,7 @@ Public Class CICRadarR
success = False success = False
End If End If
Catch Catch
If DEBUG = True Then AccessLog("Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
End If
success = False success = False
'Console.WriteLine("fu...") 'Console.WriteLine("fu...")
'Console.WriteLine(ex.Message) 'Console.WriteLine(ex.Message)
@ -548,7 +512,7 @@ Public Class CICRadarR
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 ...
Dim sendType As String = "" Dim sendType As String = ""
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory") AccessLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory")
If EnableOTP = True Then If EnableOTP = True Then
If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then If packet.Attributes.AttributeExists(RadiusAttributeType.VendorSpecific) Then
Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific) Dim VSAtts As RADIUSAttributes = packet.Attributes.GetAllAttributes(RadiusAttributeType.VendorSpecific)
@ -578,15 +542,11 @@ Public Class CICRadarR
If TSGWFirstLoginHash.Contains(UserDomain) Then If TSGWFirstLoginHash.Contains(UserDomain) Then
sid = TSGWFirstLoginHash(UserDomain).ToString sid = TSGWFirstLoginHash(UserDomain).ToString
If DEBUG = True Then AccessLog("Access token already send to phonenumber " & mobile)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Access token already send to phonenumber " & mobile)
End If
Else Else
smsCode = GenerateCode() smsCode = GenerateCode()
sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code sid = EncDec.Encrypt(UserDomain & "_" & smsCode, encCode) 'generate unique code
If DEBUG = True Then AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Sending access token: " & smsCode & " to phonenumber " & mobile)
End If
TSGWFirstLoginHash.Add(UserDomain, sid) TSGWFirstLoginHash.Add(UserDomain, sid)
TSGWFirstLoginTimeStampHash.Add(UserDomain, Now) TSGWFirstLoginTimeStampHash.Add(UserDomain, Now)
@ -610,7 +570,7 @@ Public Class CICRadarR
packet.EndPoint), _ packet.EndPoint), _
packet.Authenticator) packet.Authenticator)
' If DEBUG = True Then ' If DEBUG = True Then
'UserAccessLog.WriteLog(Now & ":" & "DEBUG: Sending access token: " & smsCode & " to phonenumber " & mobile) 'AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
'End If 'End If
' Call SendSMS(mobile, smsCode) ' Call SendSMS(mobile, smsCode)
' Console.WriteLine(smsCode) ' Console.WriteLine(smsCode)
@ -633,24 +593,19 @@ Public Class CICRadarR
Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID) Dim guidAttribute As New RADIUSAttribute(RadiusAttributeType.ReplyMessage, sGUID)
attributes.Add(guidAttribute) attributes.Add(guidAttribute)
server.SendAsResponse( _ RadiusAccept(server, packet, attributes)
New RADIUSPacket(RadiusPacketCode.AccessAccept, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End If End If
' packetHash.Remove(username.GetString & "_" & pass.GetString) ' packetHash.Remove(username.GetString & "_" & pass.GetString)
Else ' Wrong username / password ... Else ' Wrong username / password ...
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " failed to authenticate agains Active Directory") AccessLog(Now & ":" & "User " & UserDomain & " failed to authenticate agains 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
' to the response, you can sepcify Nothing instead of ' to the response, you can sepcify Nothing instead of
' creating an empty RADIUSAttributes object. ' creating an empty RADIUSAttributes object.
' packetHash.Remove(username.GetString & "_" & pass.GetString) ' packetHash.Remove(username.GetString & "_" & pass.GetString)
End If End If
@ -667,11 +622,8 @@ Public Class CICRadarR
' and drop other requests silently ... ' and drop other requests silently ...
If packet.Code <> RadiusPacketCode.AccessRequest Then If packet.Code <> RadiusPacketCode.AccessRequest Then
If DEBUG = True Then AccessLog("Not a valid radius packet.. Drop!")
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. Drop!")
End If
Exit Sub Exit Sub
End If End If
@ -689,16 +641,12 @@ Public Class CICRadarR
' 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.
If DEBUG = True Then AccessLog("Not a valid radius packet.. No username pressent.. Drop!")
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Not a valid radius packet.. No username pressent.. Drop!")
End If
Exit Sub Exit Sub
End If End If
If DEBUG = True Then AccessLog("Processing packet for user: " & username.GetString)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Processing packet for user: " & username.GetString)
End If
'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then 'If packetHash.ContainsKey(username.GetString & "_" & pass.GetString) Then
' Exit Sub ' Exit Sub
'End If 'End If
@ -706,24 +654,17 @@ Public Class CICRadarR
Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State) Dim existState As Boolean = packet.Attributes.AttributeExists(RadiusAttributeType.State)
If DEBUG = True Then AccessLog("Packet contains a state attribute? State=" & existState.ToString)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute? State=" & existState.ToString)
End If
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).GetString Dim state As String = packet.Attributes.GetFirstAttribute(RadiusAttributeType.State).GetString
If DEBUG = True Then AccessLog("Packet contains a state attribute State=" & state)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Packet contains a state attribute State=" & state)
End If
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.GetString Dim sUserName As String = username.GetString
If DEBUG = True Then
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Username = " & sUserName)
End If
Dim sPassword As String = packet.UserPassword Dim sPassword As String = packet.UserPassword
If DEBUG = True Then
UserAccessLog.WriteLog(Now & ":" & "DEBUG: SMSToken supplied by the user = " & sPassword) AccessLog("SMSToken supplied by user: " & sUserName)
End If
sid = "" sid = ""
If InStr(sUserName, "@") > 0 Then 'UPN If InStr(sUserName, "@") > 0 Then 'UPN
UserDomain = sUserName UserDomain = sUserName
@ -735,32 +676,11 @@ Public Class CICRadarR
sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode) sid = EncDec.Encrypt(UserDomain & "_" & packet.UserPassword, encCode)
' sid = UserDomain & "_" & packet.UserPassword ' sid = UserDomain & "_" & packet.UserPassword
Dim attributes As New RADIUSAttributes Dim attributes As New RADIUSAttributes
If DEBUG = True Then AccessLog("Checking for userHash " & sid)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Checking for userHash " & sid)
End If
If sid = state Then If sid = state Then
If DEBUG = True Then RadiusAccept(server, packet, attributes)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid match. Sending accept packet to Netscaler")
End If
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessAccept, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has successfully authenticated with Token")
Else Else
If DEBUG = True Then RadiusReject(server, packet, attributes)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: State and Sid does not match. Sending reject packet to Netscaler")
End If
server.SendAsResponse( _
New RADIUSPacket(RadiusPacketCode.AccessReject, _
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " has failed to authenticate. Incorrect Token")
End If End If
Else ' process the first login Else ' process the first login
@ -787,7 +707,7 @@ Public Class CICRadarR
UserDomain = NetBiosDomain & "\" & sUserName UserDomain = NetBiosDomain & "\" & sUserName
End If End If
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " is trying to log in ...") AccessLog(Now & ":" & "User " & UserDomain & " is trying to log in ...")
@ -815,9 +735,8 @@ Public Class CICRadarR
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
If DEBUG = True Then AccessLog("Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Trying to authenticate user agains Active Directory using te following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
End If
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!)
'Dim code As String = DirectCast(result.Properties("primaryTelexNumber")(0), String) 'Dim code As String = DirectCast(result.Properties("primaryTelexNumber")(0), String)
@ -835,16 +754,12 @@ Public Class CICRadarR
If UserEmail.Trim.Length = 0 Or InStr(UserEmail, "@") = 0 Then If UserEmail.Trim.Length = 0 Or InStr(UserEmail, "@") = 0 Then
success = False success = False
If DEBUG = True Then AccessLog("Unable to find correct email for user " & UserDomain)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct email for user " & UserDomain)
End If
Else Else
success = True success = True
End If End If
Catch Catch
If DEBUG = True Then AccessLog("Unable to find correct email for user " & UserDomain)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct email for user " & UserDomain)
End If
success = False success = False
End Try End Try
End If End If
@ -854,16 +769,12 @@ Public Class CICRadarR
mobile = Replace(mobile, "+", "") mobile = Replace(mobile, "+", "")
If mobile.Trim.Length = 0 Then If mobile.Trim.Length = 0 Then
success = False success = False
If DEBUG = True Then AccessLog("Unable to find correct phone number for user " & UserDomain)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number for user " & UserDomain)
End If
Else Else
success = True success = True
End If End If
Catch Catch
If DEBUG = True Then AccessLog("Unable to find correct phone number for user " & UserDomain)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Unable to find correct phone number for user " & UserDomain)
End If
success = False success = False
End Try End Try
@ -879,12 +790,12 @@ Public Class CICRadarR
'If userHash.ContainsKey(sid) Then 'If userHash.ContainsKey(sid) Then
' userHash(sid) = sPassword ' userHash(sid) = sPassword
' If DEBUG = True Then ' If DEBUG = True Then
' UserAccessLog.WriteLog(Now & ":" & "DEBUG: Updating userHash " & sid) ' AccessLog("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
' UserAccessLog.WriteLog(Now & ":" & "DEBUG: Adding userHash " & sid) ' AccessLog("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
@ -895,18 +806,15 @@ Public Class CICRadarR
success = False success = False
End If End If
Catch Catch
If DEBUG = True Then AccessLog("Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Failed to authenticate user agains Active Directory using the following parameters: " & "LDAPPAth: " & "LDAP://" & LDAPDomain & ", Username: " & UserDomain & ", Password: " & sPassword)
End If
success = False success = False
End Try End Try
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 ...
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory") AccessLog(Now & ":" & "User " & UserDomain & " authenticated agains Active Directory")
If EnableOTP = True Then If 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)
@ -919,30 +827,21 @@ Public Class CICRadarR
packet.EndPoint), _ packet.EndPoint), _
packet.Authenticator) packet.Authenticator)
If EnableSMS = True Then If EnableSMS = True Then
If DEBUG = True Then AccessLog("Sending access token: " & smsCode & " to phonenumber " & mobile)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Sending access token: " & smsCode & " to phonenumber " & mobile)
End If
Call SendSMS(mobile, smsCode) Call SendSMS(mobile, smsCode)
End If End If
If EnableEmail = True Then If EnableEmail = True Then
If DEBUG = True Then AccessLog("Sending access token: " & smsCode & " to email " & UserEmail)
UserAccessLog.WriteLog(Now & ":" & "DEBUG: Sending access token: " & smsCode & " to email " & UserEmail)
End If
Call SendEmail(UserEmail, smsCode) Call SendEmail(UserEmail, smsCode)
End If End If
Else ' One time Password not enabled, so we let the user in Else
server.SendAsResponse( _ AccessLog("One time Password not enabled, so we let the user in")
New RADIUSPacket(RadiusPacketCode.AccessAccept, _ RadiusAccept(server, packet, attributes)
packet.Identifier, attributes, _
packet.EndPoint), _
packet.Authenticator)
End If End If
' packetHash.Remove(username.GetString & "_" & pass.GetString) ' packetHash.Remove(username.GetString & "_" & pass.GetString)
Else ' Wrong username / password ... Else ' Wrong username / password ...
UserAccessLog.WriteLog(Now & ":" & "User " & UserDomain & " failed to authenticate agains Active Directory") AccessLog("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
@ -1130,14 +1029,14 @@ Public Class CICRadarR
Try Try
smtp.Send(mail) smtp.Send(mail)
If DEBUG = True Then If DEBUG = True Then
UserAccessLog.WriteLog(Now & ": Mail send to: " & email) AccessLog(Now & ": Mail send to: " & email)
End If End If
Return "SEND" Return "SEND"
Catch e As InvalidCastException Catch e As InvalidCastException
If DEBUG = True Then If DEBUG = True Then
UserAccessLog.WriteLog(Now & " : Debug: " & e.Message) AccessLog(Now & " : Debug: " & e.Message)
UserAccessLog.WriteLog(Now & " : Unable to send mail to: " & email & " ## Check that MAILSERVER and SENDEREMAIL are configured correctly in smscode.conf. Also check that your Webinterface server is allowed to relay through the mail server specified") AccessLog(Now & " : Unable to send mail to: " & email & " ## Check that MAILSERVER and SENDEREMAIL are configured correctly in smscode.conf. Also check that your Webinterface server is allowed to relay through the mail server specified")
End If End If
Return "FAILED" Return "FAILED"
End Try End Try