[Xymon] Monitoring DFS-R (2012)

Fri Mar 14 03:29:51 CET 2014

This is the most important script I run, if a server is dead someone will tell me but if DFSR stops (and it does) the copies get out of sync very quick and then bad things happen.

I found I had to run the script  from a scheduled task rather than from an entry in the bbwin config file, don't know why. The file backlog counting component is with all rights, thanks and attribs to Martin9700 at http://community.spiceworks.com/scripts/show/205-dfs-replication-monitor

Under Varaiable settings enter the path to write the test file and the path to where the file is replicated too. Don't use the DFS shares on the servers because even though you specifiy the servers if it's a DFS share AD can send you to either server.
There are 5 lines to enter the share paths but they are all contaminated and then the entries are split into pairs before processing

Regards
Graeme

option explicit
'Script to check DFS and DFS Replication
' Graeme Shea, Shea Technology Pty Ltd. 07/12/06

Dim oShell,oOutFile,oFSO,b64Bit, szLog, MFile, SFile, Status, ReplicationTime, YellowThreshold, strBacklogReport
Dim RedThreshold, ExtPath, szReportDetails, bCreateLog, aTestPaths, szTestPaths,szTestPaths1, c
Dim szTestPaths2, szTestPaths3, szTestPaths4, szTestPaths5, StartTime, FinishTime, strTemp, numBackLog, YellowBacklogThreshold, RedBacklogThreshold
Dim objExplorer, binFirstWindow, strFiles, strComputer, objWMIService, colRGroups, colRGConnections, oGroup, strResult, arrLines, arrResult
Dim colRGFolders, oFolder, strTRDomain, oConnection, binInbound, strPartner, strRGName, strRFName, strSendingComputer, strReceivingComputer

'**********************************************************************************************************
'Varaiable Settings
'The follow lines specify the paths (in pairs, on the same line). The script writes to the first location of the pair and reads
' from the second location of the pair.  5 lines are provided for conveance and all lines are concatinated
' before processing.
szTestPaths1 = "D:\apps, \\fs2\D$\apps" 
szTestPaths2 = "D:\Home\students,\\fs2\D$\Home\students"
szTestPaths3 = "D:\Home\staff,\\fs2\D$\Home\staff"
szTestPaths4 = "D:\Home\staffCmn,\\fs2\D$\Home\staffCmn" 
szTestPaths5 = ""

YellowThreshold	= 20			'Seconds before yellow warning.
RedThreshold = 50				'Seconds before red warning, Max 60 seconds, Script only waits 60 Seconds.
YellowBacklogThreshold	= 4	'Backlog file count before yellow warning.
RedBacklogThreshold = 20	'Backlog file count before red warning.

bCreateLog = False			'Create Log file for fault finding.

'**********************************************************************************************************
'Nothing to set below here.

' Graeme Shea, Shea Techology Pty Ltd. 22/03/07
'Ver 0.3 Changed 0 seconds to say less than 0.1 seconds
'Ver 0.9 Added check for replicated folder status using WMI
'Ver 0.9.1 Opens folder before writing file to fix inital unable to write test file issues
'Ver 0.9.2 Now BBWin compatable.
'Ver 0.9.3 Fixed incorrect time being reported.
'Ver 0.9.4 Adds backlog file counting.
'Ver 0.9.5 Adds replicated folder name to backlog table.

Const Version = "0.9.5 "
Const ForReading = 1 
Const ForWriting = 2 
Const ForAppending = 8
Status = "green"
StartTime = Timer()	'Start Timer to make sure script does not run too long
Set oFSO= CreateObject("Scripting.FileSystemObject")
Set oShell = WScript.CreateObject("WScript.Shell")
strComputer = oShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
WriteLog("Clear this log.")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
'On Error Resume Next
ExtPath = GetBigBrotherPath()
On Error GoTo 0

'ExtPath = "C:" ' Used for testing if client not installed
WriteLog("Got BB Extpath as: " & ExtPath)

szTestPaths = szTestPaths1 & ","  & szTestPaths2 & "," & szTestPaths3 & "," & szTestPaths4 & "," & szTestPaths5

szTestPaths = Replace(szTestPaths, ", ,", ",")
szTestPaths = Replace(szTestPaths, ",,", ",")
szTestPaths = Replace(szTestPaths, ",,", ",")
If (right(szTestPaths,1) = "," )Then szTestPaths = Left(szTestPaths, len(szTestPaths) -1)
aTestPaths = Split(szTestPaths, ",")

strBacklogReport = GetBacklogTable & vbCrLf 'Do this first so test files aren't counted in backlog.

GetFolderStatus() 'Get the status ( normal, error etc.) of replicated folders on this machine

 For c = LBound(aTestPaths) To UBound(aTestPaths) Step 2
	szReportDetails = szReportDetails & RunTest(aTestPaths(c), aTestPaths(c+ 1)) & vbCrLf
	' Lets check how long the script has been running and stop it before BB start another instance.
	FinishTime = Timer
	'Lets make sure we are not running over midnight.
	If FinishTime < StartTime Then 
      FinishTime = FinishTime + 86400 
    End If 
   If FinishTime - StartTime > 240 Then  'lets stop at 180 seconds.
   		szReportDetails = szReportDetails & VbCrLf & "&red Fatal Error, testing timed out."
		If bCreateLog Then WriteLog( VbCrLf & "Fatal Error, testing timed out.")
   		Status = "red"
   		Exit For
   End If

 Next

szReportDetails = szReportDetails & VbCrLf &  strBacklogReport 

Set oOutFile = oFSO.CreateTextFile (ExtPath &"\DFS")

If bCreateLog Then WriteLog("Created Output file ")

oOutFile.WriteLine Status & " DFS replication check completed at "& Time
oOutFile.WriteBlankLines(1)
oOutFile.WriteLine szReportDetails
oOutFile.WriteLine "DFS File replication tester for Big Brother, BBDfsRep.vbs Version " & Version
oOutFile.Close 
WriteLog("Finshed ")
WScript.quit

Function RunTest(Path1, Path2)
'************************************************************************************************
' runs the DFS repliciton test and returns results formated for BB output file
'************************************************************************************************
Dim ReplicationTime

If bCreateLog Then WriteLog("Testing replicaiton time for " & Path1 & " and " & Path2 ) 

ReplicationTime = TestReplication(Path1, Path2)

If bCreateLog Then WriteLog("	Got repliction time as " & ReplicationTime  )

If IsNumeric(ReplicationTime) Then 	
	If ReplicationTime < YellowThreshold Then
		If ReplicationTime = 0 Then

			RunTest = "&green Replication test from " & Path1 & " to " & Path2 & " took " & _
				"Less than 0.1 seconds." 
		else
			RunTest = "&green Replication test from " & Path1 & " to " & Path2 & " took " & _
				ReplicationTime & " seconds." 
		end if
	End If

	If ReplicationTime => YellowThreshold Then
		If ReplicationTime > 60 Then
			Status = "red"
			RunTest = "&red Replication test from " & Path1 & " to " & Path2 & " timed out at " & _
				ReplicationTime & " seconds." 
		Else	
			If ReplicationTime > RedThreshold Then
				Status = "red"
				RunTest = "&red Replication test from " & Path1 & " to " & Path2 & " took " & _
					ReplicationTime & " seconds." 		
			Else		
				If Status <> "red" Then
					Status = "yellow"
				End If
				RunTest = "&yellow Replication test from " & Path1 & " to " & Path2 & " took " & _
					ReplicationTime & " seconds."
			End If
		End If
	End If
Else

	Status = "red"
	RunTest = "&red Replication test from " & Path1 & " to " & Path2 & _
				" Failed with the following error " & ReplicationTime
End If

End Function

Function TestReplication(szMaster, szSlave)
	Dim testFile
	Dim i
	Dim FSO
	Dim szFileName
	Dim f

	On Error Resume Next
	Set FSO= CreateObject("Scripting.FileSystemObject")

	'Need to create a random file name for avoide conflicts
	 szFileName = "\DFSTest" & round((rnd() * 10000000))& ".txt"

	' Clean up the paths
	szMaster = Trim(szMaster)
	If Right(szMaster,1) = "\" Then
	 szMaster = Left(szMaster, Len(szMaster) - 1)
	End If

	szSlave = Trim(szSlave)
	If Right(szSlave,1) = "\" Then
	 szSlave = Left(szSlave, Len(szSlave) - 1)
	End If

	If bCreateLog Then WriteLog("Testing replication from " & szMaster & " to " & szSlave)

	i = 0

	Set f = fso.GetFolder(szMaster)
	Set f = fso.GetFolder(szSlave)
	set f = Nothing

 	Set testFile = FSO.CreateTextFile (szMaster & szFileName, True)
 	If Err Then
 		TestReplication = "Error Unable to write " & szMaster & szFileName & ". Error number " & _
 			Err.Number & " Error description " & Err.Description
 		Err.Clear
 		Exit Function
 	End If
	testFile.WriteLine ("File for automated DFS repliction testing. Created " & now)
	testFile.Close

	Do While Not oFSO.FileExists(szSlave & szFileName)
	 	i = i + 1
	 	If i > 600 Then 
	 		If bCreateLog Then WriteLog("Replicaion test timed out at " & i & " seconds")
	 		Exit Do
	 	End If

		WScript.Sleep(100)
	Loop
	'i gives us the count of tenths of seconds it took for the file to be replicated.
	if not i = 0 Then
		i = i/10
	End If

	oFSO.DeleteFile szMaster & szFileName,True

	TestReplication = i
End Function

Sub WriteLog(szText)
Dim oLogFile
	If bCreateLog Then
		If szText = "Clear this log." Then 
			Set oLogFile = oFSO.OpenTextFile (ExtPath &"\DFS.log", ForWriting, True)
	    	'oLogFile.Close
			'Exit Sub
			szText = "Beginning "
		Else
			Set oLogFile = oFSO.OpenTextFile (ExtPath &"\DFS.log", ForAppending,True)
		End If
		oLogFile.WriteLine (szText & "   at time " & time)
		oLogFile.Close
		'szLog = szLog & szText & vbCrLf
	End If
End Sub

Sub GetFolderStatus()

'States
'Uninitialized = 0
'Initialized = 1
'InitialSync = 2
'AutoRecovery = 3 
'Normal = 4
'InError = 5

'Dim objWMIService
Dim colItems
Dim objItem
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20

   'Set objWMIService = GetObject("winmgmts:\\" & "localhost" & "\root\MicrosoftDfs")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM DfsrReplicatedFolderInfo", "WQL", _
                                          wbemFlagReturnImmediately + wbemFlagForwardOnly)

   For Each objItem In colItems

      Select Case objItem.State
      	Case 0 
      			szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
      				& " in group " & objItem.ReplicationGroupName & " Reports it is not yet initialised" & VbCrLf
				If Status <> "red" Then Status = "yellow"
      	Case 1 
      			szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
      				& " in group " & objItem.ReplicationGroupName & " Reports it is Initialised" & VbCrLf
				If Status <> "red" Then Status = "yellow"
      	Case 2 
      			szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
      				& " in group " & objItem.ReplicationGroupName & " Reports it is in initial sync" & VbCrLf
				If Status <> "red" Then Status = "yellow"
      	Case 3 
      			szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
      				& " in group " & objItem.ReplicationGroupName & " Reports it is in Auto Recovery" & VbCrLf
      			szReportDetails = szReportDetails & "&yellow    Last error code = " & objItem.LastErrorCode _
      				& "  Last error msg id = " & objItem.LastErrorMessageId  & VbCrLf
				If Status <> "red" Then Status = "yellow"
      	Case 4 
      			szReportDetails = szReportDetails & "&green Folder " & objItem.ReplicatedFolderName _
      				& " in group " & objItem.ReplicationGroupName & " Reports its status is normal " & VbCrLf

      	Case 5 
      			szReportDetails = szReportDetails & "&red Folder " & objItem.ReplicatedFolderName _
      				& " in group " & objItem.ReplicationGroupName & " Reports it is in Error" & VbCrLf
      			szReportDetails = szReportDetails & "&red    Last error code = " & objItem.LastErrorCode _
      				& "  Last error msg id = " & objItem.LastErrorMessageId  & VbCrLf
				Status = "red"
      	Case Else 
      			szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
      				& " in group " & objItem.ReplicationGroupName & " Condition unknown" & VbCrLf
      			szReportDetails = szReportDetails & "&yellow    Last error code = " & objItem.LastErrorCode _
      				& "  Last error msg id = " & objItem.LastErrorMessageId  & VbCrLf
				If Status <> "red" Then Status = "yellow"

      End Select

   Next
   szReportDetails = szReportDetails & VbCrLf
End Sub

' Get path to external log files (for BB 1.08d)
Function GetBigBrotherPath()
Dim ExtPath
On Error Resume Next
ExtPath = oShell.RegRead("HKLM\SOFTWARE\Quest Software\BigBrother\bbnt\ExternalPath\")
If IsEmpty(ExtPath) Then
	ExtPath = oShell.RegRead("HKLM\SOFTWARE\BBWin\tmppath")
End If
If Not IsEmpty (ExtPath) Then  'If not empty then we have 32bit machine
	b64Bit = False
End If
If IsEmpty(ExtPath) Then
	ExtPath = oShell.RegRead("HKLM\SOFTWARE\Wow6432node\Quest Software\BigBrother\bbnt\ExternalPath\")
End If
If IsEmpty(ExtPath) Then
	ExtPath = oShell.RegRead("HKLM\SOFTWARE\Wow6432node\BBWin\tmppath")
End If

If Not IsEmpty(ExtPath) And isEmpty(b64Bit) Then 
	b64Bit = True
	err.clear
End If

If IsEmpty(ExtPath) Then
	'Put exit stuff here
End If
on Error GoTo 0
GetBigBrotherPath = ExtPath
End Function

Function PadToLength(strText)

	While Len(strText) < 25
		strText = strText & " "
	Wend

	PadToLength = strText

End Function

'#--------------------------------------------------------------------------
'#	FUNCTION.......:	GetBacklogTable
'#	PURPOSE........:	Discovers DFS tree's and returns a table displaying backlog counts
'#                      
'#	ARGUMENTS......:	
'#	EXAMPLE........:	
'#	NOTES..........:	Most (but not all) of from here down is by and with all rights, thanks and attribs to Martin9700
'#					 	at http://community.spiceworks.com/scripts/show/205-dfs-replication-monitor
'#--------------------------------------------------------------------------
Function GetBacklogTable()
WriteLog( VbCrLf & "Entered GetBacklogTable.")
Dim strHTML
	strHTML = PadToLength("Replication Group") & PadToLength("Replicated Folder") & PadToLength("Sending Partner") & PadToLength("Receiving Partner") & "Backlog (Files)" & vbCrLf
	'Set oWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
	Set colRGroups = objWMIService.ExecQuery("SELECT * FROM DfsrReplicationGroupConfig")
	WriteLog( VbCrLf & "Got colRGroups.")
	For Each oGroup in colRGroups
		Set colRGFolders = objWMIService.ExecQuery("SELECT * FROM DfsrReplicatedFolderConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
		WriteLog( VbCrLf & "Got colRGFolders.")
		For Each oFolder in colRGFolders
			Set colRGConnections = objWMIService.ExecQuery("SELECT * FROM DfsrConnectionConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
			WriteLog( VbCrLf & "Got colRGConnections.")
			strTRDomain = "d1"
			For Each oConnection In colRGConnections
				WriteLog( VbCrLf & "Got oConnection.")
				binInbound = oConnection.Inbound
				strPartner = oConnection.PartnerName
				strRGName = oGroup.ReplicationGroupName
				strRFName = oFolder.ReplicatedFolderName
				If binInbound = True Then
					strSendingComputer = strPartner
					strReceivingComputer = strComputer
				Else
					strSendingComputer = strComputer
					strReceivingComputer = strPartner
				End If
				If oConnection.Enabled = True Then
					If strTRDomain = "d1" Then
						strTRDomain = "d0"
					Else
						strTRDomain = "d1"
					End If
					WriteLog( VbCrLf & "Getting backlog, " & strSendingComputer & ", " & strReceivingComputer & ", " & strRGName & ", " & strRFName)
					numBackLog = getBackLog(strSendingComputer, strReceivingComputer, strRGName, strRFName)
					WriteLog( VbCrLf & "Backlog = " & numBackLog )
					If CDbl(RedBacklogThreshold) < CDbl(numBackLog) Then
					WriteLog("RedBacklogThreshold = " & RedBacklogThreshold)
					WriteLog("numBackLog = " & numBackLog)
					strHTML = strHTML & "&red"
   					Status = "red"
					ElseIf CDbl(YellowBacklogThreshold) < CDbl(numBackLog)  Then
					strHTML = strHTML & "&yellow"
					If Status = "green" Then Status = "yellow"
					Else
					strHTML = strHTML & "&green"
					End If
					If strSendingComputer = "." Then strSendingComputer = "LocalHost"
					If strReceivingComputer = "." Then strReceivingComputer = "LocalHost"
					strHTML = strHTML & PadToLength(strRGName) & PadToLength(strRFName)  & PadToLength(strSendingComputer) 
					strHTML = strHTML & PadToLength(strReceivingComputer) & numBackLog & " Files." & vbCrLf 'strFiles  & vbCrLf
				End If 
			Next
		Next
	Next
	strHTML = strHTML & vbCrLf & "List of Backlogged Files." & vbCrLf
	strHTML = strHTML & vbCrLf & strFiles & vbCrLf

	strHTML = strHTML & vbCrLf & "Last run on: " & date & ", " & Time & vbCrLf

	'MsgBox(strHTML)

	GetBacklogTable = strHTML
End Function

'#--------------------------------------------------------------------------
'#	SUBROUTINE.....:	showTable (Not used)
'#	PURPOSE........:	Displays HTML data in open window
'#	ARGUMENTS......:	strText: string variable of what to display, the
'#                      more HTML the better it looks!
'#	EXAMPLE........:	
'#	NOTES..........:	
'#--------------------------------------------------------------------------
Sub showTable(strText)
	If binShowWindow = False Then
		Exit Sub
	End If
	If binFirstWindow = False Then
		binFirstWindow = True
		Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
		With objExplorer
			.Navigate "about:blank"   
			.ToolBar = 0
			.StatusBar = 0
			.Width = 750
			.Height = 600 
			.Left = 0
			.Top = 0
		End With

		Do While (objExplorer.Busy)
			Wscript.Sleep 200
		Loop
		objExplorer.Visible = 1 
	End If

	On Error Resume Next
	objExplorer.Document.Body.InnerHTML = strText
	If Err.Number <> 0 Then
		Wscript.Quit
	End If
	On Error Goto 0
End Sub

'#--------------------------------------------------------------------------
'#	FUNCTION.......:	getBackLog
'#	PURPOSE........:	Retrieves the # of backlogged files, if any.  If there
'#                      are it also enumerates what files
'#	ARGUMENTS......:	strSending: sending server name
'#                      strReceiving: receiving server name
'#                      strReplicationGroup: DFS replication group
'#                      strReplicatedFolder: DFS folder being replicated
'#	EXAMPLE........:	
'#	NOTES..........:	
'#--------------------------------------------------------------------------
Function getBackLog(strSending, strReceiving, strReplicationGroup, strReplicatedFolder)
Dim x, objExec, fso, file
	WriteLog( VbCrLf & "Entered Getbacklog.")
	Set oShell = CreateObject ("Wscript.shell")
	WriteLog( VbCrLf & "Created oShell.")
	'On Error Resume Next
	 WriteLog("Running...DFSRDiag Backlog /RGName:" & strReplicationGroup & " /RFName:" & strReplicatedFolder & " /SendingMember:" & strSending & " /ReceivingMember:" & strReceiving )
	'objExec = oshell.run("dfsrdiag.exe Backlog /RGName:" & strReplicationGroup & " /RFName:" & strReplicatedFolder & " /SendingMember:" & strSending & " /ReceivingMember:" & strReceiving & " > c:\output.txt", 0, true)
	Set objExec = oshell.Exec("dfsrdiag.exe Backlog /RGName:""" & strReplicationGroup & """ /RFName:""" & strReplicatedFolder & """ /SendingMember:" & strSending & " /ReceivingMember:" & strReceiving)
	WriteLog("Finished running DFSRDiag.")

	If Err.Number Then WriteLog Err.Description

	strResult = ""
	strTemp = ""
	Do While Not objExec.StdOut.AtEndOfStream
		strResult = strResult & objExec.StdOut.ReadLine() & "\\"
		WriteLog( "Looping")
	Loop
	WriteLog( VbCrLf & "Finished loop.")
	WriteLog( VbCrLf & "strResult = " & strResult)

	If InStr(strResult, "No Backlog") > 0 or InStr(strResult, "[ERROR]") > 0 Then
		getBackLog = 0
		WriteLog("getBacklog = " & getBackLog)
	Else
		arrLines = Split(strResult, "\\")
		WriteLog("Split strResult to arrLines.")

		arrResult = Split(arrLines(1), ":")
		WriteLog("Split arrLines to arrResult.")
		getBackLog = arrResult(1)
		WriteLog("getBacklog from arrResult = " & getBackLog)
		If UBound(arrLines) > 1 Then
			strTemp = ""
			For x = 2 to UBound(arrLines)
				If InStr(arrLines(x), "Succeeded") = 0 and arrLines(x) <> "" Then
					strTemp = strTemp & arrLines(x) & vbCrLf
				End If
			Next
		End If
	End If
	strFiles = strFiles  & strTemp
End Function
-----Original Message-----
From: Xymon [mailto:xymon-bounces at xymon.com] On Behalf Of Colin Coe
Sent: Friday, 14 March 2014 10:06 AM
To: xymon at xymon.com
Subject: [Xymon] Monitoring DFS-R (2012)

Hi all

Just wondering if anyone is monitoring Windows Server 2012 DFS-R with
Xymon?  If so, any chance of sharing?

Thanks

CC

-- 
RHCE#805007969328369
_______________________________________________
Xymon mailing list
Xymon at xymon.com
http://lists.xymon.com/mailman/listinfo/xymon

Important - This email and any attachments may be confidential. If received in error, please contact us and delete all copies. Before opening or using attachments check them for viruses and defects. Regardless of any loss, damage or consequence, whether caused by the negligence of the sender or not, resulting directly or indirectly from the use of any attached files our liability is limited to resupplying any affected attachments. Any representations or opinions expressed are those of the individual sender, and not necessarily those of the Department of Education and Early Childhood Development.