DESCRIPTION
Re-locates users in the TestOU Users container according to the value set in the edsvaLOS-U attribute.
Note This code may use functions from the Active Roles Script Policy Best Practices. Please, follow the link to obtain instructions and code for those functions.
SCRIPT
'*********************************************************************************
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED
' WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'
' IF YOU WANT THIS FUNCTIONALITY TO BE CONDITIONALLY SUPPORTED,
' PLEASE CONTACT ONE IDENTITY PROFESSIONAL SERVICES.
'*********************************************************************************
'**************************************************************
Sub onPostModify(Request)
'**************************************************************
'==============================================================
'Re-locates users in the TestOU Users container according to the
'value set in the edsvaLOS-U attribute
'
'Takes in a parameter list which defines in which OU the user
'object should be placed. Parameter list is in the format:-
'
' LineOfService,OU;LineOfService,OU;LineOfService,OU
'
'
'If the edsvaLOS-U does not match with a LOS in the parameters list
'then it reports the error and stops.
'
'===============================================================
'Change the environment variables here
domainString = "dc=SomeDomain,dc=com"
parentOU = "ou=TestOU,"
'Check that it's a user - quit if not
If Request.Class <> "user" Then Exit Sub
'Check to see if any attributes other than Quick Connect internal
'attributes have changed. If so run the routine otherwise quit.
Dim bQcInternalOnly: bQcInternalOnly = True
For i=0 To Request.PropertyCount-1
If Mid(Request.Item(i).Name,1,Len("edsvaQC3")) <> "edsvaQC3" Then ' a "non-QC-internal" attribute was modified
bQcInternalOnly = False
Exit For
End If
Next
If bQcInternalOnly Then Exit Sub
'Now check to see if the edsvaLOS-U has changed - if not exit
Dim losuChanged: losuChanged = False
For i=0 To Request.PropertyCount-1
If Mid(Request.Item(i).Name,1,Len("edsvaLOS-U")) = "edsvaLOS-U" Then ' the attribute was modified
losuChanged = True
Exit For
End If
Next
If Not losuChanged Then Exit Sub
EventLog.ReportEvent 4, "MoveUser started processing"
'Get some user information
srcObjName = Request.Get("distinguishedName")
srcCN = Request.Get("cn")
srcUserName = Request.Get("samAccountName")
'Get the LOS attribute by first, loading it into the cache so it can be read
Set lUser = GetObject("EDMS://" & srcObjName)
lUser.GetInfoEx Array("edsvaLOS-U"),0
On Error Resume Next
losAttribute = lUser.Get("edsvaLOS-U")
'Check the los attribute is not empty
If losAttribute = "" Then
EventLog.ReportEvent 1, "edsvaLOS-U is empty, MoveUser terminated"
Exit Sub
End If
On Error GoTo 0
'get the parameters from the Policy Object
losList = Policy.Parameters("LOS")
'Check to see if the LOS attribute is valid by matching a value in the parameters list
If losExists(losList, losAttribute) Then
'Move the object
sourceObjectPath = "EDMS://" & srcObjName
destinationObjectOU = "ou=" & losAttribute & ","
'DN of the destination container
destinationContainerPath = "EDMS://" & destinationObjectOU & parentOU & domainString
'Bind to the destination container
'Check to see if the user is in the same OU if so, do not move
currentUserContainer = Right(srcObjName, Len(srcObjName) - Instr(srcObjName, ","))
destinationContCheck = Right(destinationContainerPath, Len(destinationContainerPath) - 7)
If Lcase(currentUserContainer) = Lcase(destinationContCheck ) Then
'Exit because we don't want to move the user if not required
EventLog.ReportEvent 4, "Target container is the same as the source - user not moved"
EventLog.ReportEvent 4, "Script module : MoveUser complete"
Exit Sub
End If
Set ContainerObject=GetObject(destinationContainerPath)
'Move the user
Set NewObject=ContainerObject.MoveHere(sourceObjectPath, vbNullString)
'Commit changes
NewObject.SetInfo
If Err.Number = 0 Then
'Set the DN explicitly
Request.PutEx ADS_PROPERTY_UPDATE, "distinguishedName", "cn=" & srcCN & "," & destinationObjectOU & parentOU & domainString
Request.SetInfo
'Get the source OU from the DN
sourceOuName = Split(srcObjname, ",")
EventLog.Reportevent 0, "User moved successfully from " & Right(sourceOuName(1), Len(sourceOuName(1))-3) & " to " & losAttribute
Else
EventLog.ReportEvent 1, "An error occured = " & err.number & " " & err.description
End If
Else
'Report the problem
EventLog.ReportEvent 1, "The edmsvaLOS-U attribute is not in the parameter list","Current Value :" & Request.Get("edsvaLOS-U")
End If
EventLog.ReportEvent 4, "Script module : MoveUser complete"
End Sub
'***************************************************************
Function losExists(lList, lAttribute)
'***************************************************************
'Checks to see if the value of the LOS attribute exists in the
'parameter list. Returns True if it does, False otherwise.
'Returns the name of the OU to the calling routine.
On Error Resume Next
parameterList = Split(Trim(lList),";")
For Each losParameter In parameterList
EventLog.ReportEvent 1, "losParam = " & losParameter(0)
losParam = Split(losParameter,",")
If lCase(losParam(0)) = lCase(lAttribute) Then
'Returns the OU name
lAttribute = losParam(1)
losExists = True
On Error GoTo 0
Exit Function
Else
losExists = False
End If
Next
On Error GoTo 0
End Function
'***** END OF CODE ***************************************************************