OpenLDAP Provisioning

Imports Microsoft.MetadirectoryServices
Imports System.DirectoryServices
Imports System.Text
Imports System.IO
Imports System.Security.Cryptography

Public Class MVExtensionObject
    Implements IMVSynchronization

    '' It is a better practise to put these constants in a lookup file
    Const OL_SERVER As String = "myldapserver.mydomain.com"
    Const OL_ROOT As String = "dc=myldap,dc=mydomain,dc=com"
    Const OL_OU_USERS As String = "ou=users,dc=myldap,dc=mydomain,dc=com"
    Const OL_UIDFILE As String = "C:\Program Files\Microsoft Forefront Identity Manager\2010\Synchronization Service\MaData\openLDAP\uidNumber.txt"
    Const OL_READ_USER As String = "cn=fimread,ou=users,dc=myldap,dc=mydomain,dc=com"
    Const OL_READ_PW As String = "password"
    Const OL_DEFAULT_GROUP As String = "1000"

    Public Sub Initialize() Implements IMVSynchronization.Initialize
        ' TODO: Add initialization code here
    End Sub

    Public Sub Terminate() Implements IMVSynchronization.Terminate
    '' Deleting this file forces a new LDAP search the next time, allowing for accounts which may have been created manually.
        If File.Exists(OL_UIDFILE) Then
            File.Delete(OL_UIDFILE)
        End If
    End Sub

    Public Sub Provision(ByVal mventry As MVEntry) Implements IMVSynchronization.Provision
        Select Case mventry.ObjectType
            Case "person"
                Provision_OpenLDAPPerson(mventry)
        End Select
    End Sub

    Sub Provision_OpenLDAPPerson(ByVal mventry As MVEntry)
        Dim ShouldExist As Boolean = False
        Dim DoesExist As Boolean
        Dim CSEntry As CSEntry
        Dim OLMA As ConnectedMA = mventry.ConnectedMAs("openLDAP")
        Dim expectedDN As ReferenceValue
        Dim Container As String

        '' Should the account exist? (Add more logic here to decide)
        ShouldExist = True

        '' Does the account already exist?
        If OLMA.Connectors.Count = 0 Then
            DoesExist = False
        Else
            DoesExist = True
        End If

        '' Generate the expected DN for the user - to use in creating or moving
        If mventry("accountName").IsPresent And ShouldExist Then
            Dim RDN As String = "cn=" & mventry("accountName").StringValue.ToLower
            expectedDN = OLMA.EscapeDNComponent(RDN).Concat(OL_OU_USERS)
        End If

        '' Take action based on values of ShouldExist and DoesExist
        If ShouldExist And DoesExist Then
            '' Check if rename needed
            If csentry.DN.ToString.ToLower <> expectedDN.ToString.ToLower Then
                csentry.DN = expectedDN
            End If

        ElseIf ShouldExist And Not DoesExist Then
            '' Create Account

            ' Set objectClasses
            Dim oc As ValueCollection
            oc = Utils.ValueCollection("inetOrgPerson")
            oc.Add("person")
            oc.Add("organizationalPerson")
            oc.Add("inetOrgPerson")
            oc.Add("posixAccount")
            oc.Add("shadowAccount")
            oc.Add("simpleSecurityObject")
            CSEntry = OLMA.Connectors.StartNewConnector("posixAccount", oc)
            CSEntry.DN = expectedDN

            ' Find next available uidNumber
            CSEntry("uidNumber").Value = = NextUidNumber(OL_SERVER, OL_ROOT).ToString

            ' Set initial password
            CSEntry("userPassword").Value = "{MD5}" & GenerateHash("INitial001")

            ' The following could also be done as export flow rules
            CSEntry("gidNumber").Value = OL_DEFAULT_GROUP
            CSEntry("sn").Value = mventry("lastName").Value
            CSEntry("givenName").Value = mventry("firstName").Value
            CSEntry("cn").Value = mventry("accountName").Value.ToLower
            CSEntry("uid").Value = mventry("accountName").Value.ToLower
            CSEntry("displayName").Value = mventry("firstName").StringValue & " " & mventry("lastName").StringValue.ToUpper

            CSEntry.CommitNewConnector()

        ElseIf Not ShouldExist And DoesExist Then
            '' Delete
            CSEntry = OLMA.Connectors.ByIndex(0)
            CSEntry.Deprovision()

        End If
    End Sub

    Public Function NextUidNumber(ByVal ldapServerName As String, ByVal searchRoot As String) As Integer
    '' The first time the function runs it finds the highest uidNumber in LDAP and stores it in a text file.
    '' On subsequent runs it retrieves the last uidNumber straight from the text file. This allows for sync runs
    '' where multiple accounts are created.
    '' The text file is deleted as part of the Terminate routine.

        Dim oSearcher As New DirectorySearcher
        Dim oResults As SearchResultCollection
        Dim oResult As SearchResult
        Dim lastuid As Integer = 0

        If File.Exists(UIDFILE) Then
            Dim fileReader As New StreamReader(UIDFILE)
            lastuid = CInt(fileReader.ReadLine)
            fileReader.Close()
        Else
            Try
                With oSearcher
                    .SearchRoot = New DirectoryEntry("LDAP://" & ldapServerName & "/" & searchRoot, _
                                                     "cn=root,dc=ldap,dc=eesp,dc=ch", "hesso_2010", AuthenticationTypes.FastBind)
                    .PropertiesToLoad.Add("uidNumber")
                    .Filter = "uidNumber=*"
                    oResults = .FindAll()
                End With

                For Each oResult In oResults
                    If oResult.GetDirectoryEntry().Properties("uidNumber").Value > lastuid Then
                        lastuid = oResult.GetDirectoryEntry().Properties("uidNumber").Value
                    End If
                Next

            Catch e As Exception
                Throw New UnexpectedDataException(e.Message)
                Return -1
            End Try
        End If

        Dim fileWriter As New StreamWriter(UIDFILE, False)
        fileWriter.WriteLine(lastuid + 1)
        fileWriter.Close()

        Return lastuid + 1
    End Function

    Private Function GenerateHash(ByVal SourceText As String) As String
        ' Returns the MD5 hash of the SourceText string.
        Dim Ue As New UTF7Encoding()
        Dim ByteSourceText() As Byte = Ue.GetBytes(SourceText)
        Dim Md5 As New MD5CryptoServiceProvider()
        Dim ByteHash() As Byte = Md5.ComputeHash(ByteSourceText)
        Return Convert.ToBase64String(ByteHash)
    End Function

End Class