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 _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 Sub Authenticate()
        Try
            Dim oEntry = GetRootNode()
            oEntry.RefreshCache()

            _rootNode = oEntry
        Catch ex As Exception
            _logger.Error(ex)
            _logger.Warn("Could not authenticate with Active Directory.")
        End Try
    End Sub
    Public Sub Authenticate(Username As String, Password As String)
        Try
            Dim oEntry = GetRootNode(Username, Password)
            oEntry.RefreshCache()

            _rootNode = oEntry
        Catch ex As Exception
            _logger.Error(ex)
            _logger.Warn("Could not authenticate with Active Directory.")
        End Try
    End Sub

    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
    Public Function ListUsers(GroupNames As List(Of String)) As List(Of ADUser)
        Try
            Dim oUsers As New List(Of ADUser)
            Dim oComparer As New UserEqualityComparer()

            For Each oGroup In GroupNames
                Dim oGroupUsers = ListUsers(oGroup)
                Dim oNewUsers = oGroupUsers.
                    Except(oUsers, oComparer).
                    ToList()
                oUsers.AddRange(oNewUsers)
            Next

            Return oUsers
        Catch ex As Exception
            _logger.Error(ex)
            Throw ex
        End Try
    End Function

    Public 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