Number of Minutes of replication latency allowed for the Root DSE to replicate
Source Code:
<DataSourceModuleType ID="Microsoft.Windows.Server.2012.AD.Availability.ReplicationShowReplCheck.DataSource" Accessibility="Internal" Batching="false">
<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="ReplLatencyThreshold" 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="RootDSEReplLatencyThreshold" type="xsd:int"/>
</Configuration>
<OverrideableParameters>
<OverrideableParameter ID="IntervalSeconds" Selector="$Config/IntervalSeconds$" ParameterType="int"/>
<OverrideableParameter ID="TimeoutSeconds" Selector="$Config/TimeoutSeconds$" ParameterType="int"/>
<OverrideableParameter ID="ReplLatencyThreshold" Selector="$Config/ReplLatencyThreshold$" ParameterType="int"/>
<OverrideableParameter ID="RootDSEReplLatencyThreshold" Selector="$Config/RootDSEReplLatencyThreshold$" ParameterType="int"/>
</OverrideableParameters>
<ModuleImplementation Isolation="Any">
<Composite>
<MemberModules>
<DataSource ID="DS" TypeID="System!System.CommandExecuterPropertyBagSource">
<IntervalSeconds>$Config/IntervalSeconds$</IntervalSeconds>
<ApplicationName>%windir%\system32\cscript.exe</ApplicationName>
<WorkingDirectory/>
<CommandLine>//nologo $file/AD_Replication_Check.vbs$ $Config/ReplLatencyThreshold$ $Config/RootDSEReplLatencyThreshold$</CommandLine>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
<RequireOutput>true</RequireOutput>
<Files>
<File>
<Name>AD_Replication_Check.vbs</Name>
<Contents><Script>'*************************************************************************
' Script Name - AD Replication Check
'
' Purpose - Checks to make sure that inbound replication is succeeding
' between DCs for each NC in the forest
'
' (c) Copyright 2014, Microsoft Corporation, All Rights Reserved
' Proprietary and confidential to Microsoft Corporation
'*************************************************************************
Option Explicit
SetLocale("en-us")
Sub Main()
Dim oAPI, oParams, oBag, sError, iReplDelay, iRootDSERepl
Set oAPI = CreateObject("Mom.ScriptAPI")
Set oBag = oAPI.CreatePropertyBag()
Set oParams = WScript.Arguments
If oParams.Count <> 2 Then
sError = "The number of command line arguments is incorrect: " & vbCrLf & _
"Expected: 2" & vbCrLf & _
"Actual: " & oParams.Count
Dim oRootDSE
Set oRootDSE = GetObject("LDAP://RootDSE")
If 0 <> Err Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "Failed to bind to the RootDSE. " & GetErrorString(Err)
Call oAPI.Return(oBag)
Exit Sub
End If
Dim sDomainDN
sDomainDN = oRootDSE.Get("defaultNamingContext")
Dim tTime
tTime = Now
Dim sShowReps
Dim aShowReps
aShowReps = GetRepAdminShowRepl
'Parse the output of repadmin /showrepl and determine replication health from the output
Dim sFailureReport, sTemp, bTimeAttempt, sDate, bDate
Dim sCurrentNC, sReplicaDC, sReplicaSite
Dim aTemp, dTimeDiff, bReplFail, bReplWarn, bNCSuccess
Dim i, iMark
bReplFail = False
bReplWarn = False
For i = 0 To UBound(aShowReps) - 1
' Look for a line containing an NC
If InStr(aShowReps(i),",DC=") Then
sCurrentNC = aShowReps(i)
bNCSuccess = False
'Check for RootDSE and set shorter replication delay for that NC
Dim iNCSpecificReplication
If sCurrentNC = sDomainDN Then
iNCSpecificReplication = iRootDSERepl
Else
iNCSpecificReplication = iReplDelay
End If
' We found a new Naming Context so we will loop on the output until
' we find an empty line indicating that we have found each replication
' partner for this NC
Do While (aShowReps(i) <> "")
i = i + 1
If InStr(aShowReps(i), "RPC") Then
If InStr(aShowReps(i), "\") Then
aTemp = Split(Trim(aShowReps(i)),"\")
iMark = InStr(aTemp(1), " ")
sReplicaDC = Left(aTemp(1), iMark)
bTimeAttempt = False
End If
ElseIf InStr(aShowReps(i), "@") Then
iMark = InStr(aShowReps(i), "@")
sTemp = Right(aShowReps(i),Len(aShowReps(i)) - (iMark+1))
' Loop on finding the next space until either no date
' is found or the string is no longer a date
iMark = InStr(sTemp, " ")
sDate = ""
bDate = False
Do While (iMark > 1)
If IsDate(Left(sTemp,iMark-1)) Then
sDate = sDate & Left(sTemp,iMark-1) & " "
bDate = True
Else
Exit Do
End If
sTemp = Right(sTemp,Len(sTemp)- iMark)
iMark = InStr(sTemp, " ")
If InStr(sTemp, ".") Then
If iMark = 0 Then
iMark = InStr(sTemp, ".")
ElseIf iMark > InStr(sTemp, ".") Then
iMark = InStr(sTemp, ".")
End If
End If
Loop
sDate = Trim(sDate)
' If a date is found find delta, else replication has never been attempted
If bDate Then
' Determine date diff to find replication delay
dTimeDiff = DateDiff("n",CDate(sDate),CDate(tTime))
If bTimeAttempt Then
sTemp = " Minutes since last success: " & dTimeDiff & vbCrLf
Else
sTemp = " Minutes since last attempt: " & dTimeDiff & vbCrLf
End If
If dTimeDiff > iNCSpecificReplication Then
' If the replication delay is longer than the threshold we have an issue
If bTimeAttempt Then
' If a second date is found for a single DC then we have a replication failure
' Check previous line to determine how many failures
sTemp = sTemp & Trim(aShowReps(i-1))
' Ping replication partner to verify that it is running. If it
' is running then set bReplFail to True. If it is not then set
' bReplWarn to True. We assume that if it is not running that
' other monitors will pickup the failure. So to reduce noise we
' verify that the DC is running before setting monitor to error
' status. If the DC is offline we set to warning.
If PingServer(sReplicaDC) Then
bReplFail = True
Else
bReplWarn = True
End If
End If
sTemp = sTemp & " Replication is delayed" & vbCrLf
sFailureReport = sFailureReport & CreateFailureReportEntry(sCurrentNC, sReplicaDC, sReplicaSite, sTemp)
bReplWarn = True
ElseIf Not(bTimeAttempt) Then
' The first date we found is less than the threshold meaning this replication partner succeeded
' so we set bNCSuccess to true since at least one DC has succeeded for this NC.
bNCSuccess = True
End If
bTimeAttempt = True
Else
sTemp = " Replication has not succeeded yet" & vbCrLf
sFailureReport = sFailureReport & CreateFailureReportEntry(sCurrentNC, sReplicaDC, sReplicaSite, sTemp)
bReplWarn = True
End If
ElseIf InStr(aShowReps(i),",DC=") Then
' We found a new Naming Context when we expected to find a blank line
' this may be a localized machine. Resetting logs and capturing new NC
sCurrentNC = aShowReps(i)
End If
Loop
If bNCSuccess Then
' If one replication partner succeeded replication with this DC then we do not warn.
' We only warn if all DC's for a partition fail.
If bReplWarn Then
bReplWarn = False
End If
End If
End If
Next
If bReplFail Then
oBag.AddValue "State", "BAD"
oBag.AddValue "ErrorString", "The monitor detected a replication failure. " _
& vbcrlf & sFailureReport
Call oAPI.Return(oBag)
ElseIf bReplWarn Then
oBag.AddValue "State", "WARN"
sTemp = "The monitor detected a replication issue. "
sTemp = sTemp & "This DC has either not completed first replication of the "
sTemp = sTemp & "NC yet and/or the last successful replication is greater "
sTemp = sTemp & "than the replication latency threshold configured for this "
sTemp = sTemp & "monitor. This warning may also occur when another DC is "
sTemp = sTemp & "offline for maintenance longer than the replication "
sTemp = sTemp & "threshold." & vbcrlf & vbcrlf & sFailureReport
oBag.AddValue "ErrorString", sTemp
'******************************************************************************
Function GetRepAdminShowRepl()
' Purpose: This function executes the command 'Repadmin /showrepl' and
' returns an array of each line from the output
' Parameters: None
'
On Error Resume Next
Dim strText, objShell, objExecObject, aOutPut, i, sError
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExecObject = objShell.Exec("cmd /c chcp 437 && repadmin /showrepl")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = strText & objExecObject.StdOut.ReadLine() & vbCrLf
Loop
If Err Then
oBag.AddValue "State", "WARN"
sError = "Failed to run Repadmin /ShowRepl. Please confirm that the "
sError = sError & "Active Directory Remote Administration tools have "
sError = sError & "been installed on this DC." & vbCrLf & GetErrorString(Err)
oBag.AddValue "ErrorString", sError
Call oAPI.Return(oBag)
WScript.Quit
End If
On Error Goto 0
aOutPut = Split(strText, vbCrLf)
For i = 0 To UBound(aOutPut) - 1
' Clean up carriage return from end of line left
aOutPut(i) = Replace(aOutPut(i), Chr(13), "")
Next
GetRepAdminShowRepl = aOutPut
End Function
'******************************************************************************
Function PingServer( sServerName )
' Purpose: This function returns True if the specified host could be pinged.
' Parameters: sServerName, can be a computer name or IP address.
'
Err.Clear
On Error Goto 0
Dim oPingResults, oResult, sQuery
' Define the WMI query
sQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & sServerName & "'"
' Run the WMI query
Set oPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery( sQuery )
If Err Then
' If an error is generated attempting to ping we assume failure
Err.Clear
On Error Resume Next
PingServer = False
End If
On Error Resume Next
' Based on results return either True or False
For Each oResult In oPingResults
If Not IsObject( oResult ) Then
PingServer = False
ElseIf oResult.StatusCode = 0 Then
PingServer = True
Else
PingServer = False
End If
Next
End Function
'******************************************************************************
Function GetErrorString(oErr)
'
' 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.)
'
Dim lErr, strErr
lErr = oErr
strErr = oErr.Description
On Error Resume Next
If 0 >= 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 = &HFFFF0000
Const HiWord8007 = &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 " & (lErr And LoWordMask))
Dim sError, i
Do
sError = oExec.stdout.ReadLine()
i = i + 1
Loop While (Len(sError) = 0) And (i < 5)
strErr = sError
End If
End If
End If
GetErrorString = vbCrLf & "The error returned was: '" & strErr & "' (0x" & Hex(lErr) & ")"
End Function
'******************************************************************************
Function CreateFailureReportEntry(sNC, sDomainController, sSite, sFailData)
'
' Purpose: Uses parameters to build report string
'
' Parameters: sNC, name of the NC that contains the failure
' sDomainController, the name of the domain controller experiencing
' a replication failure.
' sSite, the site name that the replication partner belongs to.
' sFailData, use this to send a string of what the failure was
'
' Return: String, returns a formated string used for reporting failures.
'
Dim sOut
sOut = "NC: " & sNC & vbcrlf
sOut = sOut & "DC: " & sDomainController & vbcrlf
sOut = sOut & "Site: " & sSite & vbcrlf
sOut = sOut & sFailData & vbcrlf
Home
ENU 
Show References: