Monorepo/Modules.Interfaces/ActiveDirectoryInterface.vb

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, Firebird As Firebird, MSSQL As MSSQLServer) As List(Of ADUser)
        Try
            Return SyncUsersForGroup(GroupName, New List(Of AttributeMapping), Firebird, 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), Firebird As Firebird, 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 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, Filter)
            _logger.Debug("Found {0} users", oUsers.Count)
        Catch ex As Exception
            _logger.Error(ex)
            Return Nothing
        End Try

        ' Do the actual sync into firebird
        If Firebird IsNot Nothing Then
            oSyncedUsersFirebird = oFirebirdSync.SyncUsers(GroupName, oUsers, AttributeMappings)
            If oSyncedUsersFirebird.Count > 0 Then
                _logger.Debug("Synced {0} users to Firebird", oSyncedUsersFirebird.Count)
            End If
        Else
            _logger.Debug("SyncUsersForGroup: _firebird is nothing. ")
        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.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
                                                })
                                            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