Monitor TPC Availability

TeamFoundationServer2012.MonitorTPCAvailability (UnitMonitor)

Retrieves the list of projects within a TPC which will check that the TPC is available.
Knowledge Base article:

Summary

This monitor checks availability of a Team Project Collection by calling the TFS Server APIs to query the list of associated projects.
Element properties:

Target	TeamFoundationServer2012.TFSProjectCollection
Parent Monitor	System.Health.AvailabilityState
Category	AvailabilityHealth
Enabled	True
Alert Generate	False
Alert Auto Resolve	True
Monitor Type	Microsoft.Windows.TimedScript.TwoStateMonitorType
Remotable	True
Accessibility	Public
RunAs	TFS2012UserProfile
Source Code:

<UnitMonitor ID="TeamFoundationServer2012.MonitorTPCAvailability" Accessibility="Public" Enabled="true" Target="TeamFoundationServer2012.TFSProjectCollection" ParentMonitorID="Health!System.Health.AvailabilityState" Remotable="true" 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>MonitorTPCAvailability.vbs</ScriptName>

    <Arguments>"$Target/Property[Type="TeamFoundationServer2012.TFSProjectCollection"]/BaseWSURI$" "$Target/Property[Type="TeamFoundationServer2012.TFSProjectCollection"]/ATServerNames$"</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 requestHTTP

Set requestHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

requestHTTP.SetAutoLogonPolicy(0)



Call TraceLogMessage("Entered execution MonitorTPCAvailability.vbs")  



Dim oArgs

Set oArgs = WScript.Arguments

If oArgs.Count &lt; 2 Then

   Call TraceLogMessage("Argument count is less than 2 :: exiting ")  

   Wscript.Quit -1

End If



Call TraceLogMessage("First Param - Collection URI: " &amp; oArgs(0))

Call TraceLogMessage("Second Param - AT Server List: " &amp; oArgs(1))



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

Dim wsRootURL 

wsRootURL = oArgs(0)



Dim serverNameString

serverNameString = oArgs(1)



Dim serverNames

serverNames = Split(serverNameString,"|")



Dim serverName

Dim passCount 

passCount = 0



For Each serverName in serverNames

    If CheckServer(serverName) = True Then

        passCount = 1

        Exit For

    End If

Next



Set oAPI = CreateObject("MOM.ScriptAPI")

Set oBag = oAPI.CreateTypedPropertyBag(3)



If passCount = 0 Then

    Call oBag.AddValue("Status","ERROR")

Else       

    Call oBag.AddValue("Status","OK")	

End If



Dim oAPI, oBag  



Call oAPI.AddItem(oBag)

Call oAPI.Return(oBag)



  '##########  FUNCTION : CheckServer ############################################

  

  Function CheckServer(serverURI)

    Dim baseURI

    baseURI = Replace(wsRootURL, "localhost", serverURI)



    WebServiceURL = baseURI &amp; "/Services/v3.0/CommonStructureService.asmx" 

    Call TraceLogMessage("RE-CONSTRUCTED URL = ["&amp; WebServiceURL &amp; "]")



    '========================================================================

    ' Now call the web methods 

    '========================================================================

    WebMethodName = "ListAllProjects"   

    '========================================================================= 

    '  main logic of SOAPClient

    '=========================================================================                                                                   

    'Get the Properties of the DOM right

    Set xmlDOC2 = CreateObject("MSXML.DOMDocument")

    xmlDOC2.SetProperty "SelectionLanguage", "XPath"

    XmlDOC2.Async = false

    

    'Call TraceLogMessage("Create SOAP Envelope")

    ' Create the soapEnvelope as a string body



    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;ListAllProjects xmlns=""http://schemas.microsoft.com/TeamFoundation/2005/06/Services/Classification/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("Set the RequestHTTP object and properties")



    requestHTTP.open "POST", WebServiceURL, false

    requestHTTP.setrequestheader "Content-Type", "text/xml"

    requestHTTP.setrequestheader "SOAPAction", "http://schemas.microsoft.com/TeamFoundation/2005/06/Services/Classification/03/ListAllProjects"

    requestHTTP.Send soapStr



    '''''''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)



    Set oAPI = CreateObject("MOM.ScriptAPI")

    Set oBag = oAPI.CreateTypedPropertyBag(3)

    If xmlDOC2.parseError.errorCode &lt;&gt; 0 Then

        CheckServer = false

        Call TraceLogMessage("Status: Error parsing XML result")	  	  

    Else       

        If requestHTTP.status = "200" THEN

            CheckServer = true

        Else 

            CheckServer = false

            Call TraceLogMessage("Status: ERROR")	  	  

        End If 

    End If

  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













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