Monorepo/Modules.Interfaces/ActiveDirectoryInterface.vb

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