AD Time Skew Data Source

Microsoft.Windows.Server.10.0.AD.TimeSkew.DataSource (DataSourceModuleType)

Data Source for the AD Time Skew monitors.

Element properties:

Member Modules:

Overrideable Parameters:

Source Code:

<DataSourceModuleType ID="Microsoft.Windows.Server.10.0.AD.TimeSkew.DataSource" Accessibility="Internal" Batching="false">

  <Configuration>

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

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

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

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

  </Configuration>

  <OverrideableParameters>

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

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

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

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

  </OverrideableParameters>

  <ModuleImplementation Isolation="Any">

    <Composite>

      <MemberModules>

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

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

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

          <WorkingDirectory/>

          <CommandLine>//nologo $file/AD_Time_Skew.vbs$ $Config/Threshold$ $Config/Iterations$</CommandLine>

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

          <RequireOutput>true</RequireOutput>

          <Files>

            <File>

              <Name>AD_Time_Skew.vbs</Name>

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

' Script Name - AD Time Skew Detection

'

' Purpose     - Compares the time on the local server against the time

'               on the PDC.  If it is above the configured threshold,

'               an alert will be raised.

'               

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

' Proprietary and confidential to Microsoft Corporation

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



Option Explicit



SetLocale("en-us")



Sub Main()



  Dim tmScriptStart, oBag, oAPI, oParams, sError, iThreshold, oNTInfo, iRetryMax



  'Variables for time on local machine

  Dim strLocalServer, LocalRootDSE, strLocalTime, tmLocal



  'Variables for time on PDC

  Dim strTimeServer, TimeRootDSE, strTimeTime, tmTime



  'Vars for getting the PDC FSMO

  Dim ADOconnObj, bstrADOQueryString, RootDom, RSObj, FSMOobj

  Dim CompNTDS, LocalPDC, RootPDC, strLocalPDC

  Dim iSecondsDiff

  

  Set oParams = WScript.Arguments

  Set oAPI = CreateObject("Mom.ScriptAPI") 

  Set oBag = oAPI.CreatePropertyBag()

  

  If oParams.Count &lt; 2 Then  

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

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

                      "Actual: " &amp; oParams.Count



        oBag.AddValue "State", "BAD" 

        oBag.AddValue "ErrorString", sError



        Call oAPI.Return(oBag)

        Exit Sub

  End if



  iThreshold = CInt(oParams(0))

  iRetryMax = CInt(oParams(1))



  On Error Resume Next



  set oNTInfo = CreateObject("WinNTSystemInfo")

  strLocalServer = oNTInfo.ComputerName



  tmScriptStart = Now



  Set ADOconnObj = CreateObject("ADODB.Connection")

  If Err Then

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to create ADODB Connection." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End IF



  ADOconnObj.Provider = "ADSDSOObject"

  ADOconnObj.Open "ADs Provider"





  Set RootDom = GetObjectWithRetry("LDAP://RootDSE", iRetryMax)

  If Err Then

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to contact Root DSE." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  ' Locate the local PDC

  bstrADOQueryString = "&lt;LDAP://" &amp; RootDom.Get("DnsHostName") &amp; "&gt;;(&amp;(objectClass=domainDNS)(fSMORoleOwner=*));adspath;subtree"

  Set RSObj = ADOconnObj.Execute(bstrADOQueryString)

  If Err Then

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to execute ADO query." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  Set FSMOobj = GetObjectWithRetry(RSObj.Fields(0).Value, iRetryMax)

  If Err Then 

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to locate local domain FSMO." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  Set CompNTDS = GetObjectWithRetry("LDAP://" &amp; FSMOobj.fSMORoleOwner, iRetryMax)

  If Err Then 

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to query local domain FSMO role owner." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  Set LocalPDC = GetObjectWithRetry(CompNTDS.Parent, iRetryMax)

  If Err Then 

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to locate local domain PDC." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  strLocalPDC = LocalPDC.dnsHostName



  ' If we are the PDC of the local domain

  If strLocalServer = strLocalPDC Then



    'Get a DC in the root domain

    Dim bstrRootDomainNamingContext

    Dim strServer

    bstrRootDomainNamingContext = RootDom.Get("rootDomainNamingContext")

    Set FSMOobj = GetObjectWithRetry("LDAP://" &amp; bstrRootDomainNamingContext, iRetryMax)

    If Err Then

      oBag.AddValue "State", "BAD" 

      oBag.AddValue "ErrorString", "Unable to locate root domain naming context." &amp; GetErrorString(Err)



      Call oAPI.Return(oBag)

      Exit Sub

    End If



    strServer = FSMOobj.GetOption(0)



    'Get the PDC of the root domain

    Set CompNTDS = GetObjectWithRetry("LDAP://" &amp; strServer &amp; "/" &amp; FSMOobj.fSMORoleOwner, iRetryMax)

    If Err Then 

      oBag.AddValue "State", "BAD" 

      oBag.AddValue "ErrorString", "Unable to query root domain FSMO role owner." &amp; GetErrorString(Err)



      Call oAPI.Return(oBag)

      Exit Sub

    End If



    Set RootPDC = GetObjectWithRetry(CompNTDS.Parent, iRetryMax)

    If Err Then 

      oBag.AddValue "State", "BAD" 

      oBag.AddValue "ErrorString", "Unable to locate root domain PDC." &amp; GetErrorString(Err)



      Call oAPI.Return(oBag)

      Exit Sub

    End If



    strTimeServer = RootPDC.dnsHostName ' Use the forest root PDC

  Else

    strTimeServer = LocalPDC.dnsHostName ' Use the local PDC

  End If



  If strTimeServer = "" Then 

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to locate the PDC as the time source."



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  Set LocalRootDSE = GetObjectWithRetry("LDAP://" &amp; strLocalServer &amp; "/RootDSE", iRetryMax)

  If Err Then

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to contact " &amp; strLocalServer &amp; " to determine time." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  Set TimeRootDSE = GetObjectWithRetry("LDAP://" &amp; strTimeServer &amp; "/RootDSE", iRetryMax)

  If Err Then

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to contact " &amp; strTimeServer &amp; " to determine time." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If 



  strLocalTime = LocalRootDSE.Get("currentTime")

  If Err Then

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to retrieve current time from " &amp; strLocalServer &amp; "." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  strTimeTime = TimeRootDSE.Get("currentTime")

  If Err Then

    oBag.AddValue "State", "BAD" 

    oBag.AddValue "ErrorString", "Unable to retrieve current time from " &amp; strTimeServer &amp; "." &amp; GetErrorString(Err)



    Call oAPI.Return(oBag)

    Exit Sub

  End If



  tmTime = CDate(ConvertTimeStamp(strTimeTime))

  tmLocal = CDate(ConvertTimeStamp(strLocalTime))

  

  iSecondsDiff = Abs(DateDiff("s",tmTime,tmLocal))



  If iSecondsDiff &gt; iThreshold Then

      sError = "Time check has found that the time on the current DC compared to the PDC is outside of the specified threshold." &amp; vbCrLf &amp; _

                    "The current time skew is " &amp; iSecondsDiff &amp; " second(s)." &amp; vbCrLf &amp; _

                    "Time skew threshold is " &amp; iThreshold &amp; " second(s)." &amp; vbCrLf &amp; _

                    "Time on local DC  (" &amp; strLocalServer &amp; ") is " &amp; tmLocal &amp; vbCrLf &amp; _

                    "Time on PDC (" &amp; strTimeServer &amp; ") is " &amp; tmTime



      oBag.AddValue "State", "BAD" 

      oBag.AddValue "ErrorString", sError

  Else

      oBag.AddValue "State", "GOOD" 

  End If

  

  Call oAPI.Return(oBag)



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



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

Function ConvertTimeStamp(strUTCTime)

'

' Purpose:      Convert a timestamp into a human-readable format

'

' Paramters:    strUTCTime, the timestamp to be converted

'

  dim sYear

  dim sMonth

  dim sDay

  dim sHour

  dim sMinute

  dim sSecond



  sYear = Mid(strUTCTime, 1, 4)

  sMonth = Mid(strUTCTime, 5, 2)

  sDay = Mid(strUTCTime, 7, 2)

  sHour = Mid(strUTCTime, 9, 2)

  sMinute = Mid(strUTCTime, 11, 2)

  sSecond = Mid(strUTCTime, 13, 2)



  ConvertTimeStamp = sMonth &amp; "/" &amp; sDay &amp; "/" &amp; sYear &amp; " " &amp; sHour &amp; ":" &amp; sMinute &amp; ":" &amp; sSecond

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



Main()

</Script></Contents>

            </File>

          </Files>

        </DataSource>

      </MemberModules>

      <Composition>

        <Node ID="DS"/>

      </Composition>

    </Composite>

  </ModuleImplementation>

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

</DataSourceModuleType>