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 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) 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 Private 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