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 ReadOnly _firebird As Firebird Private ReadOnly _mssql As MSSQLServer Private ReadOnly _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, MSSQL As MSSQLServer, Optional RootPath As String = Nothing) _logConfig = LogConfig _logger = _logConfig.GetLogger() _firebird = Firebird _mssql = MSSQL If RootPath Is Nothing Then _rootPath = $"LDAP://{Environment.UserDomainName}" Else _rootPath = RootPath End If _logger.Info("Using RootPath {0}", _rootPath) End Sub Public Function SyncUsersForGroup(GroupName As String) As List(Of ADUser) Try Return SyncUsersForGroup(GroupName, New List(Of AttributeMapping)) Catch ex As Exception _logger.Error(ex) Return Nothing End Try End Function Public Function SyncUsersForGroup(GroupName As String, AttributeMappings As List(Of AttributeMapping)) As List(Of ADUser) Dim oUsers As New List(Of ADUser) Dim oSyncedUsers As New List(Of ADUser) Dim oGroupId As Int64 = Nothing Dim oFirebirdSync As New SyncUsers.SyncUsersFirebird(_logConfig, _firebird) Dim oSQLSync As New SyncUsers.SyncUsersMSSQL(_logConfig, _mssql) Dim oSyncedUsersFirebird, oSyncedUsersMSSQL As List(Of ADUser) Try _logger.Debug("Fetching users from ActiveDirectory") oUsers = ListUsers(GroupName, AttributeMappings) _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 oUsers End If ' Do the actual sync into firebird If _firebird IsNot Nothing Then oSyncedUsersFirebird = oFirebirdSync.SyncUsers(GroupName, oUsers, AttributeMappings) If oSyncedUsersFirebird.Count > 0 Then _logger.Info("Synced {0} users to Firebird", oSyncedUsersFirebird.Count) End If End If ' Do the actual sync into MSSQL If _mssql IsNot Nothing Then oSyncedUsersMSSQL = oSQLSync.SyncUsers(GroupName, oUsers, AttributeMappings) If oSyncedUsersMSSQL.Count > 0 Then _logger.Info("Synced {0} users to MSSQLServer", oSyncedUsersMSSQL.Count) End If End If Return oUsers End Function Public Function Authenticate() As Boolean Try Dim oEntry = GetRootNode() oEntry.RefreshCache() _rootNode = oEntry Return True Catch ex As Exception _logger.Error(ex) _logger.Warn("Could not authenticate with Active Directory.") Return False End Try End Function Public Function Authenticate(Username As String, Password As String) As Boolean Try Dim oEntry = GetRootNode(Username, Password) oEntry.RefreshCache() _rootNode = oEntry Return True Catch ex As Exception _logger.Error(ex) _logger.Warn("Could not authenticate with Active Directory.") Return False End Try End Function 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) Return ListUsers(GroupName, New List(Of AttributeMapping)) End Function Public Function ListUsers(GroupName As String, AttributeMappings As List(Of AttributeMapping)) 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.Debug("Group {0} does not exist.", GroupName) Return oUsers End If _logger.Debug("Listing members of Group {0}", GroupName) Using oMembers = oGroupPrincipal.GetMembers(True) For Each oMember As Principal In oMembers Try If TypeOf oMember Is UserPrincipal Then Dim oUser As UserPrincipal = DirectCast(oMember, UserPrincipal) Dim oUserEx As UserPrincipalEx = UserPrincipalEx.FindByIdentity(oContext, oUser.SamAccountName) Dim oCustomAttributes As New List(Of ADUser.CustomAttribute) ' TODO: Figure out why oUserEx can be nothing for certain users If oUserEx IsNot Nothing Then For Each oMap As AttributeMapping In AttributeMappings Dim oAttributeValue = oUserEx.GetAttributeValue(oMap.AttributeName) If oAttributeValue <> String.Empty Then _logger.Debug("Attribute {0} is not empty.", oMap.AttributeName) oCustomAttributes.Add(New ADUser.CustomAttribute() With { .Name = oMap.AttributeName, .Value = oAttributeValue, .FirebirdSyskey = oMap.FirebirdSyskey, .MSSQLColumn = oMap.MSSQLColumn }) End If Next Else _logger.Debug("Could not fetch CustomAttributes for user {0}", oUser) End If _logger.Debug("Trying to add User {0} to user list", oUser) Dim oNewUser As New ADUser With { .SId = oUser.Sid, .samAccountName = oUser.SamAccountName, .Middlename = oUser.MiddleName, .GivenName = oUser.GivenName, .Email = oUser.EmailAddress, .CustomAttributes = oCustomAttributes } oUsers.Add(oNewUser) End If Catch ex As Exception _logger.Warn("User could not be processed") _logger.Error(ex) End Try Next End Using End Using End Using Return oUsers Catch ex As Exception _logger.Error(ex) Return oUsers 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.Debug("Property {0} not found", PropertyName) Return String.Empty End Try End Function End Class