PDC LDAP Bind Availability Script Data source

Microsoft.Windows.AD.DomainMemberPerspective.Availability.PDC.Bind.DataSource (DataSourceModuleType)

Data source for the PDC LDAP Bind availability monitors.

Element properties:

Member Modules:

Overrideable Parameters:

Source Code:

<DataSourceModuleType ID="Microsoft.Windows.AD.DomainMemberPerspective.Availability.PDC.Bind.DataSource" Accessibility="Internal">

  <Configuration>

    <xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="IntervalSeconds" type="xsd:int"/>

    <xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="BindIterations" type="xsd:int"/>

    <xsd:element xmlns:xsd="http://www.w3.org/2001/XMLSchema" name="TimeoutSeconds" type="xsd:int"/>

  </Configuration>

  <OverrideableParameters>

    <OverrideableParameter ID="IntervalSeconds" ParameterType="int" Selector="$Config/IntervalSeconds$"/>

    <OverrideableParameter ID="BindIterations" ParameterType="int" Selector="$Config/BindIterations$"/>

    <OverrideableParameter ID="TimeoutSeconds" ParameterType="int" Selector="$Config/TimeoutSeconds$"/>

  </OverrideableParameters>

  <ModuleImplementation>

    <Composite>

      <MemberModules>

        <DataSource ID="DS" TypeID="System!System.CommandExecuterPropertyBagSource">

          <IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>

          <ApplicationName>%windir%\system32\cscript.exe</ApplicationName>

          <WorkingDirectory/>

          <CommandLine>//nologo $file/PDC_LDAP_Bind_Availability.vbs$ $Config/BindIterations$</CommandLine>

          <TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>

          <RequireOutput>true</RequireOutput>

          <Files>

            <File>

              <Name>PDC_LDAP_Bind_Availability.vbs</Name>

              <Contents><Script>'*************************************************************************

' Script Name - PDC LDAP Bind Availability 

'

' Purpose     - Monitors that binds to the PDC work as expected

'               

' (c) Copyright 2014, Microsoft Corporation, All Rights Reserved

' Proprietary and confidential to Microsoft Corporation              

'*************************************************************************



Option Explicit



SetLocale("en-us")



Sub Main()



  Dim oAPI, oBag, oParams, sError, oRootDSE, oDomain, oNtds, oFsmo, oFsmoHolder

  Dim oBind, iIteration, iMaxIterations



  Set oAPI = CreateObject("Mom.ScriptAPI")  

  Set oBag = oAPI.CreatePropertyBag()

  Set oParams = WScript.Arguments



  if oParams.Count &lt;&gt; 1 then

      sError = "The number of command line arguments is incorrect: " &amp; vbCrLf &amp; _

               "Expected: 1" &amp; vbCrLf &amp; _

               "Actual: " &amp; oParams.Count

        

        oBag.AddValue "State", "BAD" 

        oBag.AddValue "ErrorString", sError



        Call oAPI.Return(oBag)

        Exit Sub 

  End if



  iMaxIterations = CInt(oParams(0))

  

  if iMaxIterations &lt; 1 then

    iMaxIterations = 3

  End if



  On Error Resume Next



  Set oRootDSE = GetObjectWithRetry("LDAP://rootDSE", iMaxIterations)



  If (Err.Number &lt;&gt; 0) Then

	oBag.AddValue "State", "BAD"

    oBag.AddValue "ErrorString", "Unable to bind to the rootDSE." &amp; GetErrorString(Err)

    oAPI.AddItem oBag 

    

    Call oAPI.Return(oBag)

    Exit Sub        

  End if



  Set oDomain = GetObjectWithRetry("LDAP://" &amp; oRootDSE.Get("defaultNamingContext"), iMaxIterations)



  If (Err.Number &lt;&gt; 0) Then

	oBag.AddValue "State", "BAD"

    oBag.AddValue "ErrorString", "Unable to get the defaultNamingContext naming context." &amp; GetErrorString(Err)

    oAPI.AddItem oBag 

    

    Call oAPI.Return(oBag)

    Exit Sub        

  End if



  oFsmo = oDomain.Get("fSMORoleOwner")



  If (Err.Number &lt;&gt; 0) Then

	oBag.AddValue "State", "BAD"

    oBag.AddValue "ErrorString", "Unable to lookup the fSMORoleOwner property." &amp; GetErrorString(Err)

    oAPI.AddItem oBag 

    

    Call oAPI.Return(oBag)

    Exit Sub        

  End if



  Set oNtds = GetObjectWithRetry("LDAP://" &amp; oFsmo, iMaxIterations)



  If (Err.Number &lt;&gt; 0) Then

	oBag.AddValue "State", "BAD"

    oBag.AddValue "ErrorString", "Unable to connect to the fSMORoleOwner " &amp; oFsmo &amp; "." &amp; GetErrorString(Err)

    oAPI.AddItem oBag 

    

    Call oAPI.Return(oBag)

    Exit Sub        

  End if



  Set oFsmoHolder = GetObjectWithRetry(oNtds.Parent, iMaxIterations)



  If (Err.Number &lt;&gt; 0) Then

	oBag.AddValue "State", "BAD"

    oBag.AddValue "ErrorString", "Unable to get the fSMORoleOwner " &amp; oFsmo &amp; "." &amp; GetErrorString(Err)

    oAPI.AddItem oBag 

    

    Call oAPI.Return(oBag)

    Exit Sub        

  End if



  Set oBind = GetObjectWithRetry("LDAP://" &amp; oFsmoHolder.dnsHostName &amp; "/rootDSE", iMaxIterations)



  If (Err.Number = 0) Then

    oBag.AddValue "State", "GOOD"

    oAPI.AddItem oBag    

        

    Call oAPI.Return(oBag)

    Exit Sub               

  End If



  oBag.AddValue "State", "BAD"

  oBag.AddValue "ErrorString", "Unable to bind to the FSMO holder " &amp; oFsmoHolder.dnsHostName &amp; "." &amp; GetErrorString(Err)

  oAPI.AddItem oBag   



  oAPI.ReturnItems 

End Sub



'******************************************************************************

' Name:         GetObjectWithRetry

'

' Purpose:      Gets object instance, retrying attempt iRetryMax times if GetObject fails

'

' Paramters:    strObjectQuery, the string paramenter for GetObject

'		iRetryMax, the integer parameter for retry iterations max

'

' Return:       Object instance

'

Function GetObjectWithRetry(strObjectQuery, iRetryMax)

  dim ret, iRetry

  iRetry = 0



  On Error Resume Next 



  Do

    'Reset Err object

    Err.Clear

    'Attempt to get an object

    Set ret = GetObject(strObjectQuery)

    'If no errors then skip retry 

    If Err = 0 Then        

      Exit Do

    End If

    'Wait a sec before next attempt

    wscript.sleep(1000)

    iRetry = iRetry + 1

  Loop While (iRetry &lt; iRetryMax) 



  Set GetObjectWithRetry = ret

End Function



'******************************************************************************

' Name:         GetErrorString

'

' Purpose:      Attempts to find the description for an error if an error with 

'               no description is passed in.

' 

' Parameters:   oErr, the error object

'

' Return:       String, the description for the error.  (Includes the error code.)

'

Function GetErrorString(oErr)

  Dim lErr, strErr

  lErr = oErr

  strErr = oErr.Description



  On Error Resume Next

  If 0 &gt;= Len(strErr) Then

    ' If we don't have an error description, then check to see if the error

    ' is a 0x8007xxxx error.  If it is, then look it up.

    Const ErrorMask = &amp;HFFFF0000  

    Const HiWord8007 = &amp;H80070000

    Const LoWordMask = 65535          ' This is equivalent to 0x0000FFFF



    If (lErr And ErrorMask) = HiWord8007 Then

      ' Attempt to use 'net helpmsg' to get a description for the error.

      Dim oShell

      Set oShell = CreateObject("WScript.Shell")

      If Err = 0 Then

        Dim oExec 

        Set oExec = oShell.Exec("net helpmsg " &amp; (lErr And LoWordMask))



        Dim strMessage, i

        Do

          strMessage = oExec.stdout.ReadLine()

          i = i + 1

        Loop While (Len(strMessage) = 0) And (i &lt; 5)



        strErr = strMessage

      End If

    End If	

  End If



  GetErrorString = vbCrLf &amp; vbCrLf &amp; "The error returned was: '" &amp; strErr &amp; "' (0x" &amp; Hex(lErr) &amp; ")"

End Function



Call Main()

</Script></Contents>

              <Unicode>1</Unicode>

            </File>

          </Files>

        </DataSource>

      </MemberModules>

      <Composition>

        <Node ID="DS"/>

      </Composition>

    </Composite>

  </ModuleImplementation>

  <OutputType>System!System.PropertyBagData</OutputType>

</DataSourceModuleType>