MonitorForBuildWebService

TeamFoundationServer2012.MonitorForBuildWebService (UnitMonitor)

Monitor for Build Web Service

Knowledge Base article:

Summary

Monitors the TFS Build web service for availability on each AT Tier server.

Causes

If an error occurs on this monitor it is likely due to an AT Tier server not being available. Check to make sure the AT tier server reporting the error is running.

Element properties:

TargetTeamFoundationServer2012.TFSBuildWebService
Parent MonitorSystem.Health.AvailabilityState
CategoryAvailabilityHealth
EnabledTrue
Alert GenerateFalse
Alert Auto ResolveFalse
Monitor TypeMicrosoft.Windows.TimedScript.TwoStateMonitorType
RemotableFalse
AccessibilityPublic
RunAsTFS2012UserProfile

Source Code:

<UnitMonitor ID="TeamFoundationServer2012.MonitorForBuildWebService" Accessibility="Public" Enabled="true" Target="TeamFoundationServer2012.TFSBuildWebService" 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>TFS2012BuildWSMonitor.vbs</ScriptName>
<Arguments>$Target/Property[Type="TeamFoundationServer2012.TFSBaseWebService"]/InstalledPort$ $Target/Property[Type="TeamFoundationServer2012.TFSBaseWebService"]/useSSL$ $Target/Property[Type="TeamFoundationServer2012.TFSBaseWebService"]/VirtualDirectory$</Arguments>
<ScriptBody><Script>Option Explicit
SetLocale("en-us")

''''###### Monitor For Authorization Web Service #######
Dim logOutputEnabled
' Change this to log all messages in this script to the event log
logOutputEnabled = false

Dim oArgs
Set oArgs = WScript.Arguments
If oArgs.Count &lt; 3 Then
Call TraceLogMessage("Argument count is less than 2 :: exiting ")
Wscript.Quit -1
End If

i_InstalledPort = oArgs(0)
Dim useSSL
useSSL = ConvStrBool(oArgs(1))

Dim VirtualDirectory
VirtualDirectory = oArgs(2)

Dim requestHTTP
Set requestHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
requestHTTP.SetAutoLogonPolicy(0)
requestHTTP.Option(4) = 13056

Dim oAPI, oBag

Dim WebServiceURL, WebMethodName, xmlDOC2, soapStr, serviceName, serviceUrl, bOK

WebServiceURL = GetTfsUrl() &amp; "/Build/V1.0/BuildStore.asmx"
Call TraceLogMessage("RE-CONSTRUCTED URL = ["&amp; WebServiceURL &amp; "]")

'========================================================================
' Now call the web methods
'========================================================================
' 1. Test the GetRegistrationEntries method
WebMethodName = "ListObjectClasses"
'=========================================================================
' 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 &amp; "&lt;?xml version=""1.0"" encoding=""utf-8""?&gt;" &amp; vbCrLf
soapStr = soapStr &amp; "&lt;soap:Envelope "
soapStr = soapStr &amp; " xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
soapStr = soapStr &amp; " xmlns:xsd=""http://www.w3.org/2001/XMLSchema"""
soapStr = soapStr &amp; " xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/""&gt;"
soapStr = soapStr &amp; vbCrLf
soapStr = soapStr &amp; " &lt;soap:Body&gt;" &amp; vbCrLf
soapStr = soapStr &amp; " &lt;GetBuildQualities xmlns=""http://schemas.microsoft.com/TeamFoundation/2005/06/Build/BuildInfo/03""/&gt; "
soapStr = soapStr &amp; vbCrLf
soapStr = soapStr &amp; " &lt;/soap:Body&gt;" &amp; vbCrLf
soapStr = soapStr &amp; " &lt;/soap:Envelope&gt;" &amp; vbCrLf
'Call TraceLogMessage("submitted SOAPSTRING:=&gt;" &amp; soapStr)

'Call TraceLogMessage("Set the RequestHTTP object and properties")

'Call TraceLogMessage("Set the RequestHTTP object and properties")
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oBag = oAPI.CreateTypedPropertyBag(3)

requestHTTP.open "POST", WebServiceURL, false
requestHTTP.setrequestheader "Content-Type", "text/xml"
requestHTTP.setrequestheader "SOAPAction", "http://schemas.microsoft.com/TeamFoundation/2005/06/Build/BuildInfo/03/GetBuildQualities"
On Error Resume Next
requestHTTP.Send soapStr
If Err.number = 0 Then
'''''''DO the XML processing''''''''''''''''''
'========================================================================
' Load the respone.xml into DOM for XPATH processing
'========================================================================
Dim responseText, myError
responseText = requestHTTP.responseText
Call TraceLogMessage("Result of WS Call: " &amp; responseText)
bOK = xmlDOC2.loadXML(responseText)

If xmlDOC2.parseError.errorCode &lt;&gt; 0 Then
myError = xmlDOC2.parseError
Call TraceLogMessage("You have parse error on loading XmlDOC2" )
Call oBag.AddValue("Status","ERROR")
Else
If requestHTTP.status = "200" Then
WriteOutput(true)
Else
WriteOutput(false)
End If
End If
Else
WriteOutput(false)
End If

Function WriteOutput(result)
Set oAPI = CreateObject("MOM.ScriptAPI")
Set oBag = oAPI.CreateTypedPropertyBag(3)
if result = true 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)
WScript.Quit 0
End Function

'########## 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 : GetInstallPath ############################################
Public Function GetInstallPath(componentName)
const HKEY_LOCAL_MACHINE = &amp;H80000002
Dim strKeyPath, strEntryName, strValue
Dim objRef, objReg

Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

strKeyPath = "SOFTWARE\Microsoft\TeamFoundationServer\11.0\InstalledComponents\" &amp; componentName
strEntryName = "InstallPath"

' Get the Registry Key
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strEntryName,strValue

GetInstallPath = strValue
End Function

'########## FUNCTION : GetDefaultProject ############################################
Public Function GetDefaultProjectCollectionPath()
Call TraceLogMessage("Entering GetDefaultProjectCollectionPath")

Dim defaultProjectPath
defaultProjectPath = ""

Dim port
port = i_InstalledPort
Call TraceLogMessage("Installed Port is: " &amp; port)

Dim url
If useSSL = True Then
url = "https://localhost:" &amp; port &amp; VirtualDirectory
Else
url = "http://localhost:" &amp; port &amp; VirtualDirectory
End If

WebServiceURL = url &amp; "TeamFoundation/Administration/v3.0/TeamProjectCollectionService.asmx"

'========================================================================
' Now call the web methods
'========================================================================
'Get the Properties of the DOM right
Dim xmlDOC
Set xmlDOC = CreateObject("MSXML.DOMDocument")
xmlDOC.SetProperty "SelectionLanguage", "XPath"
XmlDOC.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 &amp; "&lt;?xml version=""1.0"" encoding=""utf-8""?&gt;" &amp; vbCrLf
soapStr = soapStr &amp; "&lt;soap:Envelope "
soapStr = soapStr &amp; " xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
soapStr = soapStr &amp; " xmlns:xsd=""http://www.w3.org/2001/XMLSchema"""
soapStr = soapStr &amp; " xmlns=""http://microsoft.com/webservices/"""
soapStr = soapStr &amp; " xmlns:soap=""http://www.w3.org/2003/05/soap-envelope""&gt;"
soapStr = soapStr &amp; vbCrLf
soapStr = soapStr &amp; " &lt;soap:Body&gt;" &amp; vbCrLf
soapStr = soapStr &amp; " &lt;GetDefaultCollectionId /&gt; "
soapStr = soapStr &amp; vbCrLf
soapStr = soapStr &amp; " &lt;/soap:Body&gt;" &amp; vbCrLf
soapStr = soapStr &amp; " &lt;/soap:Envelope&gt;" &amp; vbCrLf
'Call TraceLogMessage("submitted SOAPSTRING:=&gt;" &amp; soapStr)

'Call TraceLogMessage("Set the RequestHTTP object and properties")

requestHTTP.open "POST", WebServiceURL, false
requestHTTP.setrequestheader "Content-Type", "text/xml"
requestHTTP.setrequestheader "SOAPAction", "http://microsoft.com/webservices/GetDefaultCollectionId"
On Error Resume Next
requestHTTP.Send soapStr
If Err.number = 0 Then

'''''''DO the XML processing''''''''''''''''''
'========================================================================
' Load the respone.xml into DOM for XPATH processing
'========================================================================
Dim responseText
responseText = requestHTTP.responseText
Call TraceLogMessage("Response from WS Call: " &amp; responseText )

bOK = xmlDOC.loadXML(responseText)
If (bOK = true) Then
Dim defaultProjectGuid
defaultProjectGuid = xmlDOC.text
Call TraceLogMessage("Default Project GUID: " &amp; defaultProjectGuid )

defaultProjectPath = GetDefaultProjectPathValue(defaultProjectGuid)
End If

Call TraceLogMessage("Return Value GetDefaultProjectCollectionPath: " &amp; defaultProjectPath )
GetDefaultProjectCollectionPath = defaultProjectPath
Else
WriteOutput(false)
End If
End Function

'########## FUNCTION : GetDefaultProjectPath ############################################
Public Function GetDefaultProjectPathValue(projectGuid)

Call TraceLogMessage("Entering GetDefaultProjectPath")

Dim defaultProjectPath

Dim port
port = i_InstalledPort
Call TraceLogMessage("Installed Port is: " &amp; port)

Dim url
if useSSL = True Then
url = "https://localhost:" &amp; port &amp; VirtualDirectory
Else
url = "http://localhost:" &amp; port &amp; VirtualDirectory
End If
Call TraceLogMessage("Base URL: " &amp; url)

WebServiceURL = url &amp; "TeamFoundation/Administration/v3.0/TeamProjectCollectionService.asmx"

'========================================================================
' Now call the web methods
'========================================================================
soapStr = ""
soapStr = soapStr &amp; "&lt;?xml version=""1.0"" encoding=""utf-8""?&gt;" &amp; vbCrLf
soapStr = soapStr &amp; "&lt;soap:Envelope "
soapStr = soapStr &amp; " xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"""
soapStr = soapStr &amp; " xmlns:xsd=""http://www.w3.org/2001/XMLSchema"""
soapStr = soapStr &amp; " xmlns=""http://microsoft.com/webservices/"""
soapStr = soapStr &amp; " xmlns:soap=""http://www.w3.org/2003/05/soap-envelope""&gt;"
soapStr = soapStr &amp; vbCrLf
soapStr = soapStr &amp; " &lt;soap:Body&gt;" &amp; vbCrLf
soapStr = soapStr &amp; " &lt;GetCollectionProperties&gt;&lt;ids&gt;&lt;guid&gt; "
soapStr = soapStr &amp; projectGuid
soapStr = soapStr &amp; " &lt;/guid&gt;&lt;/ids&gt;&lt;/GetCollectionProperties&gt; "
soapStr = soapStr &amp; vbCrLf
soapStr = soapStr &amp; " &lt;/soap:Body&gt;" &amp; vbCrLf
soapStr = soapStr &amp; " &lt;/soap:Envelope&gt;" &amp; vbCrLf
'Call TraceLogMessage("submitted SOAPSTRING:=&gt;" &amp; soapStr)

Call TraceLogMessage("Set the RequestHTTP object and properties")

requestHTTP.open "POST", WebServiceURL, false
requestHTTP.setrequestheader "Content-Type", "text/xml"
requestHTTP.setrequestheader "SOAPAction", "http://microsoft.com/webservices/GetCollectionProperties"
requestHTTP.Send soapStr

'''''''DO the XML processing''''''''''''''''''
'========================================================================
' Load the respone.xml into DOM for XPATH processing
'========================================================================
Dim responseText
responseText = requestHTTP.responseText
Call TraceLogMessage("Response Text: " &amp; responseText)

'Get the Properties of the DOM right
Dim xmlDOC
Set xmlDOC = CreateObject("MSXML.DOMDocument")
xmlDOC.SetProperty "SelectionLanguage", "XPath"
XmlDOC.Async = false
xmlDOC.SetProperty "SelectionNamespaces", "xmlns:tns='http://microsoft.com/webservices/'"

bOK = xmlDOC.loadXML(responseText)
If (bOK = true) Then
Dim collectionNode
Set collectionNode = xmlDOC.selectSingleNode("//tns:GetCollectionPropertiesResponse/tns:GetCollectionPropertiesResult/tns:TeamProjectCollectionProperties")
Dim tempPath
tempPath = collectionNode.getAttribute("vdir")
Call TraceLogMessage("vdir Attribute is: " &amp; tempPath)

If (Left(tempPath,1) = "~") Then
defaultProjectPath = Mid(tempPath,3,Len(tempPath)-3)
Else
defaultProjectPath = tempPath
End If
End If
Call TraceLogMessage("Return value - defaultProjectPath: " &amp; defaultProjectPath)

GetDefaultProjectPathValue = defaultProjectPath
End Function

'########## FUNCTION : GetTFSUrl ############################################
Public Function GetTFSUrl()
Call TraceLogMessage("Getting TFS Url")

Dim port
port = i_InstalledPort
Call TraceLogMessage("Installed Port is: " &amp; port)

Dim defaultProject
defaultProject = GetDefaultProjectCollectionPath()

Dim url
If useSSL = True Then
url = "https://localhost:" &amp; port &amp; VirtualDirectory &amp; defaultProject
Else
url = "http://localhost:" &amp; port &amp; VirtualDirectory &amp; defaultProject
End If
Call TraceLogMessage("TFS Base URI for default project:" &amp; url)

GetTFSUrl = url
End Function

Public Function ConvStrBool(value)
If UCase(value) = "TRUE" Then
ConvStrBool = True
Else
ConvStrBool = False
End If
End Function

Private i_InstalledPort

</Script></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>