Imports System.DirectoryServices Imports System.DirectoryServices.AccountManagement Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging Public Class ActiveDirectoryInterface Private _logConfig As LogConfig Private _logger As Logger Private _firebird As Firebird Private _rootPath As String Private _rootNode As DirectoryEntry Private Const SEARCH_LIMIT = 50000 Private Const SAMACCOUNTNAME = "samaccountname" Private Const OBJECTCLASS = "objectClass" Private Const CN = "cn" Private Const DESCRIPTION = "description" Private Const DISINGUISHEDNAME = "distinguishedName" Private Const NAME = "name" Private Const OBJECTCATEGORY = "objectCategory" Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional RootPath As String = Nothing) _logConfig = LogConfig _logger = _logConfig.GetLogger() _firebird = Firebird If RootPath Is Nothing Then _rootPath = $"LDAP://{Environment.UserDomainName}" Else _rootPath = RootPath End If End Sub Public Function SyncUsersForGroup(GroupName As String) As List(Of ADUser) Dim oUsers As New List(Of ADUser) Dim oSyncedUsers As New List(Of ADUser) Dim oGroupId As Int64 = Nothing Try _logger.Debug("Fetching users from ActiveDirectory") oUsers = ListUsers(GroupName) _logger.Debug("Found {0} users", oUsers.Count) Catch ex As Exception _logger.Error(ex) Return Nothing End Try If oUsers.Count = 0 Then _logger.Debug("Group {0} does not contain any users.", GroupName) Return oSyncedUsers End If Try _logger.Debug("Getting group Id for group {0}", GroupName) oGroupId = GetGroupId(GroupName) If oGroupId = 0 Then _logger.Warn("Group {0} does not exist in database. Exiting", GroupName) Return Nothing End If _logger.Debug("Using group Id {0}", oGroupId) Catch ex As Exception _logger.Error(ex) Return Nothing End Try For Each oUser In oUsers Dim oUserId As Int64 Dim oUserExists As Boolean = False ' Check if user already exists Try _logger.Debug("Checking if user {0} exists", oUser) oUserId = GetUserId(oUser.samAccountName) oUserExists = Not IsNothing(oUserId) _logger.Debug("User {0} exists in database: ", oUser, oUserExists) Catch ex As Exception _logger.Error(ex) _logger.Warn("Could not get UserId for user. Skipping") Continue For End Try ' I user does not exist, create a new user Try If Not oUserExists Then _logger.Debug("Creating new user for {0}", oUser) oUserId = CreateUser(oUser) _logger.Debug("User created with Id {0}", oUserId) End If Catch ex As Exception _logger.Error(ex) _logger.Warn("Could not create user. Skipping") Continue For End Try ' Add the user to group Try AddUserToGroup(oUserId, oGroupId) Catch ex As Exception _logger.Error(ex) _logger.Warn("Could not add user to group. Skipping") Continue For End Try oSyncedUsers.Add(oUser) Next Return oSyncedUsers End Function Public Sub Authenticate() Try Dim oEntry = GetRootNode() oEntry.RefreshCache() _rootNode = oEntry Catch ex As Exception _logger.Error(ex) _logger.Warn("Could not authenticate with Active Directory.") End Try End Sub Public Sub Authenticate(Username As String, Password As String) Try Dim oEntry = GetRootNode(Username, Password) oEntry.RefreshCache() _rootNode = oEntry Catch ex As Exception _logger.Error(ex) _logger.Warn("Could not authenticate with Active Directory.") End Try End Sub Public Function ListGroups(Optional Query As String = "(&(objectClass=group) (samAccountName=*))") As List(Of ADGroup) Return ListGroups(_rootNode, Query) End Function Public Function ListGroups(RootNode As DirectoryEntry, Optional Query As String = "(&(objectClass=group) (samAccountName=*))") As List(Of ADGroup) Dim oGroups As New List(Of ADGroup) Try Dim oDirectorySearcher As New DirectorySearcher(RootNode) With { .SearchScope = SearchScope.Subtree, .SizeLimit = SEARCH_LIMIT, .Filter = Query } Dim oResults As SearchResultCollection = oDirectorySearcher.FindAll() _logger.Info("Found {0} Groups.", oResults.Count) Return GroupResultsToList(oResults) Catch ex As Exception _logger.Error(ex) Return oGroups End Try End Function Public Function ListUsers(GroupName As String) As List(Of ADUser) Dim oUsers As New List(Of ADUser) Try Using oContext As New PrincipalContext(ContextType.Domain) Using oGroupPrincipal As GroupPrincipal = GroupPrincipal.FindByIdentity(oContext, IdentityType.Name, GroupName) If oGroupPrincipal Is Nothing Then _logger.Warn("Group {0} does not exist.", GroupName) Return oUsers End If Using oMembers = oGroupPrincipal.GetMembers(True) For Each oMember As Principal In oMembers If TypeOf oMember Is UserPrincipal Then Dim oUser As UserPrincipal = DirectCast(oMember, UserPrincipal) oUsers.Add(New ADUser() With { .GUID = oUser.Guid, .SId = oUser.Sid, .samAccountName = oUser.SamAccountName, .Surname = oUser.Surname, .Middlename = oUser.MiddleName, .GivenName = oUser.GivenName, .Email = oUser.EmailAddress }) End If Next End Using End Using End Using Return oUsers Catch ex As Exception _logger.Error(ex) Throw ex End Try End Function Public Function ListUsers(GroupNames As List(Of String)) As List(Of ADUser) Try Dim oUsers As New List(Of ADUser) Dim oComparer As New UserEqualityComparer() For Each oGroup In GroupNames Dim oGroupUsers = ListUsers(oGroup) Dim oNewUsers = oGroupUsers. Except(oUsers, oComparer). ToList() oUsers.AddRange(oNewUsers) Next Return oUsers Catch ex As Exception _logger.Error(ex) Throw ex End Try End Function Public Function GetGroupId(GroupName As String) As Integer Try Dim oSQL As String = $"SELECT FNICM_GET_RECORD4SYSKEY('{GroupName}','002-NAME') from RDB$DATABASE" Dim oGroupId = _firebird.GetScalarValue(oSQL) If IsDBNull(oGroupId) OrElse oGroupId = 0 Then _logger.Debug("Group {0} not found in database", GroupName) Return Nothing End If Return oGroupId Catch ex As Exception _logger.Error(ex) Throw ex End Try End Function Private Function GetUserId(UserName As String) As Integer Try Dim oSQL As String = $"SELECT FNICM_GET_RECORD4SYSKEY('{UserName}','001-USRNAME') from RDB$DATABASE" Dim oResult = _firebird.GetScalarValue(oSQL) If IsDBNull(oResult) Then Return Nothing End If Return oResult Catch ex As Exception _logger.Error(ex) Throw ex End Try End Function Private Function CreateUser(User As ADUser) As Int64 Try Dim oSQL = $"SELECT FNICM_RADM_NEW_USER('{User.GivenName}', '{User.Surname}', '{User.samAccountName}', 'AD-Sync') from RDB$DATABASE" Dim oUserId As Integer = _firebird.GetScalarValue(oSQL) Return oUserId Catch ex As Exception _logger.Error(ex) Throw ex End Try End Function Private Function AddUserToGroup(UserId As Integer, GroupId As Integer) As Int64 Try Dim oSQL = $"SELECT FNICM_RADM_NEW_USER2GROUP({UserId}, {GroupId}, 'AD-Sync') from RDB$DATABASE" Dim oRecordId = _firebird.GetScalarValue(oSQL) If IsDBNull(oRecordId) Then _logger.Warn("UserId {0} - GroupId {1} relation already exists.", UserId, GroupId) Return Nothing End If Return oRecordId Catch ex As Exception _logger.Error(ex) Throw ex End Try End Function Private Function GetRootNode() As DirectoryEntry Dim oEntry As New DirectoryEntry(_rootPath) With { .AuthenticationType = AuthenticationTypes.Secure, .Password = Nothing, .Username = Nothing } Return oEntry End Function Private Function GetRootNode(Username As String, Password As String) As DirectoryEntry Dim oEntry As New DirectoryEntry(_rootPath) With { .AuthenticationType = AuthenticationTypes.Secure, .Password = Username, .Username = Password } Return oEntry End Function Private Function GroupResultsToList(Results As SearchResultCollection) As List(Of ADGroup) Dim oGroups As New List(Of ADGroup) For Each oResult As SearchResult In Results oGroups.Add(New ADGroup() With { .Name = TryGetProperty(oResult, NAME), .SAMAccountName = TryGetProperty(oResult, SAMACCOUNTNAME), .CN = TryGetProperty(oResult, CN), .Description = TryGetProperty(oResult, DESCRIPTION), .DistinguishedName = TryGetProperty(oResult, DISINGUISHEDNAME), .ObjectCategory = TryGetProperty(oResult, OBJECTCATEGORY), .ObjectClass = TryGetProperty(oResult, OBJECTCLASS) }) Next Return oGroups End Function Private Function TryGetProperty(Result As SearchResult, PropertyName As String) As String Try Return Result.Properties.Item(PropertyName).Item(0) Catch ex As Exception _logger.Warn("Property {0} not found") Return String.Empty End Try End Function End Class