Back to User management: Provision
DESCRIPTION
This is a example of script-based PVG-policy with generation rule. It may be used instead regular PVG-policy to provide more functionality.
Note This code may use functions from the ARS 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 MERCHANTBILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
'
' IF YOU WANT THIS FUNCTIONALITY TO BE CONDITIONALLY SUPPORTED,
' PLEASE CONTACT QUEST PROFESSIONAL SERVICES.
'*********************************************************************************
'
' This code is published on the ActiveRoles Script Center:
' http://communities.quest.com/docs/DOC-9991
'
' This code may use functions from the ARS Script Policy Best Practices:
' http://communities.quest.com/docs/DOC-10016
'
' Please, follow the link to obtain instructions and code for those functions.
'*********************************************************************************
Option Explicit
Const strScriptName = "Full PVG - generation rule"
'***********************************************************************************
'** CUSTOMIZABLE SETTINGS
'***********************************************************************************
Const strInterestingClass = "user" ' "user" object class
Const strInterestingAttribute = "displayName" ' "displayName" attribute
'***********************************************************************************
Const boolValueMustBeSpecified = True ' True -or- False
Const boolValueIsRestricted = True ' -//-
Const boolValueIsAutoGenerated = False ' -//-
Const strValueGenerationRule = "%<givenName> %<initials>. %<sn>" ' Empty -or- generation rule
Dim arrPossibleValues ' Empty -or- array of string values
arrPossibleValues = Empty
Dim strGeneratedValue ' Empty -or- string value
strGeneratedValue = GetFirstOf(arrPossibleValues)
Const numMaximalValueLength = 30 ' Empty -or- integer value
Dim enumValueCaseAdjusting ' Empty -or- one of EDS_CHAR_TRANSFORMATION_TYPE_*
enumValueCaseAdjusting = EDS_CHAR_TRANSFORMATION_TYPE_NONE
Const strProhibitedSymbols = "$#" ' Empty -or- string with prohibited symbols
Const strAdministrativeNote = "Admin note" ' Empty -or- string with administrative note
Const strErrorMessage = "Corporate policy violation" ' Empty -or- string with error message
Dim boolValueCanBeFixed ' True -or- False
boolValueCanBeFixed = (GetArrayDim(arrPossibleValues) = 1) _
Or (Not IsEmpty(strValueGenerationRule))
'***********************************************************************************
'** SUBROUTINES
'***********************************************************************************
'*** ARS-related subroutines *******************************************************
Function GetAttribute (ByRef objObject, ByVal strAttribute)
Dim Value
On Error Resume Next
Value = objObject.Get(strAttribute)
On Error GoTo 0
GetAttribute = Value
End Function ' GetAttribute
Function GetAttributeDirObj (ByRef objObject, ByVal strAttribute)
Dim Value
On Error Resume Next
Value = objObject.Get(strAttribute)
On Error GoTo 0
If (IsEmpty(Value)) Then
On Error Resume Next
Value = DirObj.Get(strAttribute)
On Error GoTo 0
End If
GetAttributeDirObj = Value
End Function ' GetAttributeDirObj
Function IsAttributeModified (ByRef Request, ByVal strAttribute)
Dim objEntry, nControlCode, boolResult
Set objEntry = Request.GetPropertyItem(strAttribute, ADSTYPE_CASE_IGNORE_STRING)
boolResult = False
If Not (objEntry Is Nothing) Then
nControlCode = objEntry.ControlCode
Select Case nControlCode
Case ADS_PROPERTY_CLEAR, ADS_PROPERTY_UPDATE, ADS_PROPERTY_APPEND
boolResult = True
End Select
End If
IsAttributeModified = boolResult
End Function ' IsAttributeModified
Function GetInControl (ByRef objObject, ByVal strControl)
Dim Value
On Error Resume Next
Value = objObject.GetInControl(strControl)
If (Value = Empty) Then Value = Null
On Error GoTo 0
GetInControl = Value
End Function ' GetInControl
'*** GUID-related subroutines ******************************************************
Function IsWellFormedGuid(ByVal Guid)
IsWellFormedGuid = False
If (Len(Guid) = 36) Then
If (Mid(Guid,9,1) <> "-") Then Exit Function
If (Mid(Guid,14,1) <> "-") Then Exit Function
If (Mid(Guid,19,1) <> "-") Then Exit Function
If (Mid(Guid,24,1) <> "-") Then Exit Function
ElseIf (Len(Guid) = 38) Then
If (Mid(Guid,1,1) <> "{") Then Exit Function
If (Mid(Guid,10,1) <> "-") Then Exit Function
If (Mid(Guid,15,1) <> "-") Then Exit Function
If (Mid(Guid,20,1) <> "-") Then Exit Function
If (Mid(Guid,25,1) <> "-") Then Exit Function
If (Mid(Guid,38,1) <> "}") Then Exit Function
Else
Exit Function
End If
IsWellFormedGuid = True
End Function
Function IsGUIDsEqual (ByVal Guid1, ByVal Guid2)
Dim objOctetString
IsGUIDsEqual = False
If (IsEmpty(Guid1) Or IsNull(Guid1)) Then Exit Function
If (IsEmpty(Guid2) Or IsNull(Guid2)) Then Exit Function
Set objOctetString = CreateObject("AelitaEDM.EDMOctetString")
If (Not IsWellFormedGuid(Guid1)) Then
Call objOctetString.Set(Guid1)
Guid1 = objOctetString.GetGUIDString()
End If
If (Not IsWellFormedGuid(Guid2)) Then
Call objOctetString.Set(Guid2)
Guid2 = objOctetString.GetGUIDString()
End If
IsGUIDsEqual = (UCase(Guid1) = UCase(Guid2))
End Function
'*** Array-related subroutines *****************************************************
'--- get array dimension
Function GetArrayDim(ByVal Arr)
GetArrayDim= True
If (Not IsArray(Arr)) Then Exit Function
GetArrayDim = UBound(Arr)+1
End Function ' GetArrayDim
'--- is array empty
Function IsEmptyArray(ByVal Arr)
IsEmptyArray = True
If (Not IsArray(Arr)) Then Exit Function
If (GetArrayDim(Arr)=0) Then Exit Function
IsEmptyArray = False
End Function ' IsEmptyArray
'--- get first emelent of array
Function GetFirstOf(ByVal Arr)
GetFirstOf = Empty
If (Not IsEmptyArray(Arr)) Then GetFirstOf = Arr(0)
End Function ' GetFirstOf
'--- get last emelent of array
Function GetLastOf(ByVal Arr)
GetLastOf = Empty
If (Not IsEmptyArray(Arr)) Then GetLastOf = Arr(UBound(Arr))
End Function ' GetLastOf
'--- does value exist in array
Function IsOneOf(ByVal Arr, ByVal Val)
Dim Val2
IsOneOf = False
For Each Val2 In Arr
If (Val = Val2) Then
IsOneOf = True
Exit Function
End If
Next
End Function ' IsOneOf
'***********************************************************************************
'--- generate value with accordance to strValueGenerationRule
Function GenerateValue(ByRef objObject)
Dim Value1, Value2, Value3, FinalValue
Value1 = GetAttributeDirObj(objObject, "givenName")
Value2 = GetAttributeDirObj(objObject, "initials")
Value3 = GetAttributeDirObj(objObject, "sn")
FinalValue = ""
If (Not IsEmpty(Value1)) Then FinalValue = FinalValue & " " & Value1
If (Not IsEmpty(Value2)) Then FinalValue = FinalValue & " " & Value2 & "."
If (Not IsEmpty(Value3)) Then FinalValue = FinalValue & " " & Value3
GenerateValue = Trim(FinalValue)
End Function ' GenerateValue
Function CheckValue(ByRef objObject, ByVal Value)
CheckValue = True
If ((Not IsEmpty(strValueGenerationRule)) And (strValueGenerationRule <> "")) Then
If (Value = GenerateValue(objObject)) Then
Exit Function
End If
End If
If ((Not IsEmpty(strGeneratedValue)) And (strGeneratedValue <> "")) Then
If (Value = strGeneratedValue) Then
Exit Function
End If
End If
If ((Not IsEmpty(arrPossibleValues)) And (IsArray(arrPossibleValues))) Then
If (IsOneOf(arrPossibleValues,Value)) Then
Exit Function
End If
End If
CheckValue = False
End Function
Sub FixValue(ByRef objObject)
If ((Not IsEmpty(strValueGenerationRule)) And (strValueGenerationRule <> "")) Then
Call objObject.Put(strInterestingAttribute, GenerateValue(objObject))
Exit Sub
End If
If ((Not IsEmpty(strGeneratedValue)) And (strGeneratedValue <> "")) Then
Call objObject.Put(strInterestingAttribute, strGeneratedValue)
Exit Sub
End If
If ((Not IsEmpty(arrPossibleValues)) And (IsArray(arrPossibleValues))) Then
If (Not IsEmptyArray(arrPossibleValues)) Then
Call objObject.Put(strInterestingAttribute, GetFirstOf(arrPossibleValues))
Exit Sub
End If
End If
End Sub
'***********************************************************************************
'** EVENT HANDLERS
'***********************************************************************************
'-----------------------------------------------------------------------------------
'-- onGetPolicyMarker
'-----------------------------------------------------------------------------------
Function onGetPolicyMarker()
'-- We are emulating a PVG policy by script,
'-- thus we need to give a policy marker like PVG.
'-- The policy marker for PVG must be in format "PVG:{class}-{attribute}"
onGetPolicyMarker = "PVG:" & strInterestingClass & "-" & strInterestingAttribute
End Function ' onGetPolicyMarker
'-----------------------------------------------------------------------------------
'-- onPreCreate
'-----------------------------------------------------------------------------------
Sub onPreCreate(Request)
If (LCase(Request.Class) <> LCase(strInterestingClass)) Then Exit Sub
Dim Value
If (IsAttributeModified(Request,strInterestingAttribute)) Then
Value = GetAttribute(Request, strInterestingAttribute)
If (CheckValue(Request, Value) = False) Then
Call Err.Raise (EDS_EVENTLOG_ERROR_TYPE, strErrorMessage)
End If
Else
FixValue(Request)
End If
End Sub ' onPreCreate
'-----------------------------------------------------------------------------------
'-- onPreModify
'-----------------------------------------------------------------------------------
Sub onPreModify(Request)
If (LCase(Request.Class) <> LCase(strInterestingClass)) Then Exit Sub
Dim Value
If (IsAttributeModified(Request,strInterestingAttribute)) Then
Value = GetAttribute(Request, strInterestingAttribute)
If (CheckValue(Request, Value) = False) Then
Call Err.Raise (EDS_EVENTLOG_ERROR_TYPE, strErrorMessage)
End If
Else
FixValue(Request)
End If
End Sub ' onPreModify
'-----------------------------------------------------------------------------------
'-- onCheckPropertyValues
'-----------------------------------------------------------------------------------
Sub onCheckPropertyValues(Request)
If (LCase(Request.Class) <> LCase(strInterestingClass)) Then Exit Sub
Dim strCheckPolicyGUID, strFixPolicyGUID, strOurGUID
Dim Value
strCheckPolicyGUID = GetInControl(Request,EDS_CONTROL_CHECK_POLICY_COMPLIANCE)
strFixPolicyGUID = GetInControl(Request,EDS_CONTROL_FIX)
strOurGUID = Policy.GUID
If ((Not IsEmpty(strCheckPolicyGUID)) And (IsGUIDsEqual(strCheckPolicyGUID,strOurGUID))) Then
Value = GetAttribute(DirObj, strInterestingAttribute)
If (CheckValue(Request, Value) = False) Then
Call Request.SetPolicyComplianceInfo(strInterestingAttribute, EDS_POLICY_COMPLIANCE_ERROR, strErrorMessage, boolValueCanBeFixed)
End If
If (IsNull(strFixPolicyGUID) Or IsGUIDsEqual(strFixPolicyGUID,strOurGUID)) Then
Call FixValue(DirObj)
Call DirObj.SetInfo()
End If
ElseIf (IsAttributeModified(Request,strInterestingAttribute)) Then
Value = GetAttribute(Request, strInterestingAttribute)
If (CheckValue(Request, Value) = False) Then
Call Request.SetPolicyComplianceInfo(strInterestingAttribute, EDS_POLICY_COMPLIANCE_ERROR, strErrorMessage, boolValueCanBeFixed)
End If
End If
End Sub ' onCheckPropertyValues
'-----------------------------------------------------------------------------------
'-- onGetEffectivePolicy
'-----------------------------------------------------------------------------------
Sub onGetEffectivePolicy(Request)
If (LCase(Request.Class) <> LCase(strInterestingClass)) Then Exit Sub
If ((Not IsEmpty(boolValueMustBeSpecified)) And (boolValueMustBeSpecified)) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_VALUE_REQURIED, True)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_VALUE_REQURIED)
End If
If ((Not IsEmpty(boolValueIsRestricted )) And (boolValueIsRestricted )) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_RESTRICTED, True)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_RESTRICTED)
End If
If ((Not IsEmpty(boolValueIsAutoGenerated)) And (boolValueIsAutoGenerated)) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_AUTO_GENERATED, True)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_AUTO_GENERATED)
End If
If ((Not IsEmpty(strValueGenerationRule)) And (strValueGenerationRule <> "")) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_POLICY_RULE, strValueGenerationRule)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_POLICY_RULE)
End If
If ((Not IsEmpty(strGeneratedValue)) And (strGeneratedValue <> "") And (Request.Parameter("InterestingRequestType") = EDST_REQ_CREATE)) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_GENERATED_VALUE, strGeneratedValue)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_GENERATED_VALUE)
End If
If ((Not IsEmpty(arrPossibleValues)) And (IsArray(arrPossibleValues))) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_POSSIBLE_VALUES, arrPossibleValues)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_POSSIBLE_VALUES)
End If
If ((Not IsEmpty(strAdministrativeNote)) And (strAdministrativeNote <> "")) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_DISPLAY_NOTE, strAdministrativeNote)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_DISPLAY_NOTE)
End If
If ((Not IsEmpty(numMaximalValueLength)) And (numMaximalValueLength > 0)) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_MAX_LENGHT, numMaximalValueLength)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_MAX_LENGHT)
End If
If ((Not IsEmpty(enumValueCaseAdjusting)) _
And (enumValueCaseAdjusting = EDS_CHAR_TRANSFORMATION_TYPE_NONE _
Or enumValueCaseAdjusting = EDS_CHAR_TRANSFORMATION_TYPE_TO_UPPERCASE _
Or enumValueCaseAdjusting = EDS_CHAR_TRANSFORMATION_TYPE_TO_LOWERCASE)) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_ADJUST_CASE, enumValueCaseAdjusting)
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_ADJUST_CASE)
End If
If ((Not IsEmpty(strProhibitedSymbols )) And (strProhibitedSymbols <> "")) Then
Call Request.SetEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_PROHIBITED_SYMBOLS, strProhibitedSymbols )
Else
Call Request.ClearEffectivePolicyInfo(strInterestingAttribute, EDS_EPI_UI_PROHIBITED_SYMBOLS)
End If
End Sub ' onGetEffectivePolicy
'****************** END OF CODE ****************************************************
'***** END OF CODE ***************************************************************
COMPATIBILITY
Script compatible with the following version(s): <Not specified>