Monitors the availability of the Build Controller
Monitors the availability of the build controller(s) by calling the TFS APIs to query the last status of the controller.
| Target | TeamFoundationServer2012.TFSBuildController |
| Parent Monitor | System.Health.AvailabilityState |
| Category | AvailabilityHealth |
| Enabled | True |
| Alert Generate | False |
| Alert Auto Resolve | False |
| Monitor Type | Microsoft.Windows.TimedScript.TwoStateMonitorType |
| Remotable | False |
| Accessibility | Public |
| RunAs | TFS2012UserProfile |
Home<UnitMonitor ID="TeamFoundationServer2012.MonitorBuildControllerAvailability" Accessibility="Public" Enabled="true" Target="TeamFoundationServer2012.TFSBuildController" ParentMonitorID="Health!System.Health.AvailabilityState" Remotable="false" Priority="Normal" RunAs="TFS2012UserProfile" TypeID="Windows!Microsoft.Windows.TimedScript.TwoStateMonitorType" ConfirmDelivery="false">
<Category>AvailabilityHealth</Category>
<OperationalStates>
<OperationalState ID="Success" MonitorTypeStateID="Success" HealthState="Success"/>
<OperationalState ID="Error" MonitorTypeStateID="Error" HealthState="Warning"/>
</OperationalStates>
<Configuration>
<IntervalSeconds>300</IntervalSeconds>
<SyncTime/>
<ScriptName>MonitorControllerBuildAvailabilty.vbs</ScriptName>
<Arguments>$Target/Property[Type="TeamFoundationServer2012.TFSBuildController"]/URI$ $Target/Property[Type="TeamFoundationServer2012.TFSBuildController"]/HostName$</Arguments>
<ScriptBody> Option Explicit
SetLocale("en-us")
Dim logOutputEnabled
' Change this to log all messages in this script to the event log
logOutputEnabled = true
Call TraceLogMessage("Running Build Controller Health Script")
Dim requestHTTP
Set requestHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
requestHTTP.SetAutoLogonPolicy(0)
Dim oArgs
Set oArgs = WScript.Arguments
If oArgs.Count < 2 Then
Call TraceLogMessage("Argument count is less than 2 :: exiting ")
Wscript.Quit -1
End If
Dim baseWSURI
baseWSURI = GetWSRootURL()
Dim oAPI, oBag
Dim controllerURI, computerName
controllerURI = oArgs(0)
computerName = oArgs(1)
computerName = Mid(computerName, 1, InStr(computerName, ".") -1)
Call TraceLogMessage("Controller URI = ["& controllerURI & "]")
Call TraceLogMessage("computerName = ["& computerName & "]")
Dim WebServiceURL, xmlDOC2, soapStr, serviceName, serviceUrl, bOK
WebServiceURL = baseWSURI & "/Build/V3.0/AdministrationService.asmx"
Call TraceLogMessage("RE-CONSTRUCTED URL = ["& WebServiceURL & "]")
'========================================================================
' Now call the web methods
'========================================================================
' 1. Test the GetRegistrationEntries method
'=========================================================================
' main logic of SOAPClient
'=========================================================================
'Get the Properties of the DOM right
Set xmlDOC2 = CreateObject("MSXML.DOMDocument")
xmlDOC2.SetProperty "SelectionLanguage", "XPath"
XmlDOC2.Async = false
' Do a simple polling check on GetBuildQualities Web Service and check its return status.
'Call TraceLogMessage("Create SOAP Envelope")
' Create the soapEnvelope as a string body
soapStr = ""
soapStr = soapStr & "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf
soapStr = soapStr & "<soap:Envelope "
soapStr = soapStr & " xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
soapStr = soapStr & " xmlns:xsd=""http://www.w3.org/2001/XMLSchema"""
soapStr = soapStr & " xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
soapStr = soapStr & " <soap:Body>" & vbCrLf
soapStr = soapStr & " <QueryBuildServiceHosts xmlns=""http://tempuri.org/""> " & vbCrLf
soapStr = soapStr & " <computer>" & computerName &"</computer>" & vbCrLf
soapStr = soapStr & " </QueryBuildServiceHosts> " & vbCrLf
soapStr = soapStr & " </soap:Body>" & vbCrLf
soapStr = soapStr & " </soap:Envelope>" & vbCrLf
'Call TraceLogMessage("submitted SOAPSTRING:=>" & soapStr)
'Call TraceLogMessage("Set the RequestHTTP object and properties")
requestHTTP.open "POST", WebServiceURL, false
requestHTTP.setrequestheader "Content-Type", "text/xml"
requestHTTP.setrequestheader "SOAPAction", "http://tempuri.org/QueryBuildServiceHosts"
requestHTTP.Send soapStr
'''''''DO the XML processing''''''''''''''''''
'========================================================================
' Load the response.xml into DOM for XPATH processing
'========================================================================
Dim responseText, myError
responseText = requestHTTP.responseText
Call TraceLogMessage("Result of WS Call: " & responseText)
bOK = xmlDOC2.loadXML(responseText)
xmlDOC2.SetProperty "SelectionNamespaces", "xmlns:tns='http://tempuri.org/'"
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oBag = oAPI.CreateTypedPropertyBag(3)
IF xmlDOC2.parseError.errorCode <> 0 THEN
myError = xmlDOC2.parseError
Call TraceLogMessage("You have parse error on loading XmlDOC2" )
Call oBag.AddValue("Status","ERROR")
ELSE
On Error Goto 0
Dim resultValue
resultValue = "FAIL"
Dim controllerNodes, controllerNode
Set controllerNodes = xmlDOC2.selectNodes("//tns:QueryBuildServiceHostsResponse/tns:QueryBuildServiceHostsResult/tns:Controllers/tns:BuildController")
For Each controllerNode in controllerNodes
Dim att
Dim isMatch
Dim status
Dim uri
isMatch = False
For Each att in controllerNode.attributes
IF att.name = "Uri" THEN
uri = att.value
IF att.value = controllerUri THEN
isMatch=True
END IF
END IF
if att.name = "Status" THEN
status = att.value
END IF
NEXT
IF isMatch = True THEN
resultValue = Status
TraceLogMessage("controller uri " & uri & " status is " & resultValue)
ELSE
TraceLogMessage("controller uri " & uri & " is not a match")
END IF
Next
IF requestHTTP.status = "200" AND resultValue <> "FAIL" THEN
Call oBag.AddValue("Status","OK")
Call TraceLogMessage("Status: OK")
ELSE
Call oBag.AddValue("Status","ERROR")
Call TraceLogMessage("Status: ERROR")
END IF
Call oAPI.AddItem(oBag)
Call oAPI.Return(oBag)
END IF
'########## FUNCTION : TraceLogMessage ############################################
' Since we want to hold this value between Call to the script, initialize it outside the TraceLogMessage function
Dim ScriptFileName, oAPITemp
Function TraceLogMessage(ByVal sMessage)
If logOutputEnabled = true Then
On Error Resume Next
WScript.Echo sMessage
If IsEmpty(ScriptFileName) = True Then
' Retrieve the name of this (running) script
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
ScriptFileName = FSO.GetFile(WScript.ScriptFullName).Name
Set FSO = Nothing
End If
If IsEmpty(oAPITemp) = True Then
Set oAPITemp = CreateObject("MOM.ScriptAPI")
End If
oAPITemp.LogScriptEvent ScriptFileName, 4002, 4, sMessage
On Error Goto 0
End If
End Function
'########## FUNCTION : GetWSRootURL ############################################
Public Function GetWSRootURL()
const HKEY_LOCAL_MACHINE = &H80000002
Dim strKeyPath, strEntryName, strValue
Dim objRef, objReg
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\VisualStudio\11.0\TeamFoundation\Build\ServiceHost"
strEntryName = "ApplicationServerUrl"
' Get the Registry Key
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strEntryName,strValue
Call TraceLogMessage("WS URL from registry = ["& strValue & "]")
GetWSRootURL = strValue
End Function
</ScriptBody>
<TimeoutSeconds>300</TimeoutSeconds>
<ErrorExpression>
<SimpleExpression>
<ValueExpression>
<XPathQuery Type="String">Property[@Name='Status']</XPathQuery>
</ValueExpression>
<Operator>Equal</Operator>
<ValueExpression>
<Value Type="String">ERROR</Value>
</ValueExpression>
</SimpleExpression>
</ErrorExpression>
<SuccessExpression>
<SimpleExpression>
<ValueExpression>
<XPathQuery Type="String">Property[@Name='Status']</XPathQuery>
</ValueExpression>
<Operator>Equal</Operator>
<ValueExpression>
<Value Type="String">OK</Value>
</ValueExpression>
</SimpleExpression>
</SuccessExpression>
</Configuration>
</UnitMonitor>