Imports System.DirectoryServices Imports System.DirectoryServices.AccountManagement Imports System.Text.RegularExpressions Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging Public Class ActiveDirectoryInterface Private _logConfig As LogConfig Private _logger As Logger 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 Const DEFAULT_USER_FILTER = "(&(objectClass=user)(samAccountName=@SAMACCOUNTNAME)(!(UserAccountControl:1.2.840.113556.1.4.803:=2)))" Public Const DEFAULT_GROUP_FILTER = "(&(objectClass=group) (samAccountName=*))" Public Sub New(LogConfig As LogConfig, Optional RootPath As String = Nothing) _logConfig = LogConfig _logger = _logConfig.GetLogger() 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, MSSQL As MSSQLServer) As List(Of ADUser) Try Return SyncUsersForGroup(GroupName, New List(Of AttributeMapping), MSSQL) Catch ex As Exception _logger.Error(ex) Return Nothing End Try End Function Public Function SyncUsersForGroup(GroupName As String, AttributeMappings As List(Of AttributeMapping), MSSQL As MSSQLServer, Optional Filter As String = DEFAULT_USER_FILTER) As List(Of ADUser) Dim oUsers As New List(Of ADUser) Dim oSyncedUsers As New List(Of ADUser) Dim oGroupId As Int64 = Nothing Dim oSQLSync As New SyncUsers.SyncUsersMSSQL(_logConfig, MSSQL) Dim oSyncedUsersMSSQL As List(Of ADUser) Try _logger.Debug("Fetching users from ActiveDirectory") oUsers = ListUsers(GroupName, AttributeMappings, Filter) _logger.Debug("Found {0} users", oUsers.Count) Catch ex As Exception _logger.Error(ex) Return Nothing End Try ' Do the actual sync into MSSQL If MSSQL IsNot Nothing Then oSyncedUsersMSSQL = oSQLSync.SyncUsers(GroupName, oUsers, AttributeMappings) If oSyncedUsersMSSQL.Count > 0 Then _logger.Debug("Synced {0} users to MSSQLServer", oSyncedUsersMSSQL.Count) End If Else _logger.Debug("SyncUsersForGroup: _mssql is nothing. ") 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 = DEFAULT_GROUP_FILTER) As List(Of ADGroup) Return ListGroups(_rootNode, Query) End Function Public Async Function ListGroupsAsync(Optional Query As String = DEFAULT_GROUP_FILTER) As Task(Of List(Of ADGroup)) Return Await Task.Run(Function() ListGroups(Query)) End Function Public Function ListGroups(RootNode As DirectoryEntry, Optional Query As String = DEFAULT_GROUP_FILTER) 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, Optional Filter As String = DEFAULT_USER_FILTER) As List(Of ADUser) Return ListUsers(GroupName, New List(Of AttributeMapping), Filter) End Function Public Async Function ListUsersAsync(GroupName As String, Optional Filter As String = DEFAULT_USER_FILTER) As Task(Of List(Of ADUser)) Return Await Task.Run(Function() ListUsers(GroupName, Filter)) End Function Public Function ListUsers(GroupName As String, AttributeMappings As List(Of AttributeMapping), Optional Filter As String = DEFAULT_USER_FILTER) 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, IdentityType.SamAccountName, oUser.SamAccountName) Dim oCustomAttributes As New List(Of ADUser.CustomAttribute) Dim oUserFound = FindUserWithFilter(oUserEx, Filter) If oUserFound = False Then _logger.Debug("User [{0}] was skipped out due to user filter.", oUserEx.SamAccountName) Continue For End If _logger.Debug("User [{0}] passed the filter.", oUserEx.SamAccountName) ' 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 }) Else _logger.Debug("Attribute [{0}] is empty.", oMap.AttributeName) 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, .Surname = oUser.Surname, .GUID = oUser.Guid, .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 Public Function FindUserWithFilter(User As UserPrincipalEx, Filter As String) As Boolean Try Dim oRootPath = String.Join(","c, User.DistinguishedName.Split(","c).Skip(1)) Dim oPlaceholder = "@SAMACCOUNTNAME" Dim oProtocol = "LDAP://" Dim oEntry As New DirectoryEntry(oProtocol & oRootPath) With { .Username = Nothing, .Password = Nothing, .AuthenticationType = AuthenticationTypes.Secure } If Filter = String.Empty Then _logger.Debug("FindUserWithFilter: Filter was empty, returning True for User [{0}]", User.SamAccountName) Return True End If If Filter.Contains(oPlaceholder) Then Filter = Filter.Replace(oPlaceholder, User.SamAccountName) Else _logger.Warn("FindUserWithFilter: Placeholder [{0}] was not found in filter. Results may not be correct.") End If Dim oSearcher As New DirectorySearcher(oEntry, Filter) Dim oResult As SearchResult = oSearcher.FindOne() If oResult IsNot Nothing AndAlso oResult.Path.Replace(oProtocol, String.Empty) = User.DistinguishedName Then Return True Else Return False End If Catch ex As Exception _logger.Warn("FindUserWithFilter: Unhandled exception.") _logger.Error(ex) Return False 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