File: C:/Windows/OEM/WireServer.wsf
<?XML version="1.0" ?>
<package>
<?component error="true" debug="true" ?>
<comment>
Supports container-level operations against the wireserver protocol
</comment>
<component id="WireServer">
<registration
progid="WaGuest.WireServer"
description=""
version="1.0.0.0"
clsid="{E35BB49D-20C1-4762-BB63-F548FD83A690}"/>
<public>
<property name="WScript" />
<property name="ServerAddress" />
<method name="Initialize" />
<method name="PutProvisioningStatus">
<param name="status" />
<param name="substatus" />
<param name="description" />
<param name="properties" />
</method>
<method name="GetCertificates" />
<method name="GetGoalState">
<param name="maxRetryTimeInSecs" />
</method>
<method name="SendTelemetry">
<param name="operation" />
<param name="message" />
<param name="durationMS" />
</method>
</public>
<resource id="1" />
<object id="WshShell" progid="WScript.Shell" />
<object id="FSO" progid="Scripting.FileSystemObject" />
<script language="VBScript" src="Utility.vbs" />
<script language="VBScript"><![CDATA[
Option Explicit
Const ERROR_NOTINITALIZED = 1
Const ERROR_NOWIRESERVER = 3
Const ERROR_NOSUPPORTEDVERSION = 5
Const ERROR_TRANSPORTCERTFAILURE = 6
Const ERROR_DISCOVERYFAILURE = 7
Const RCP_SUPPORTED_VERSION = "2015-04-05"
Const WIRE_SERVER_IP_ADDRESS = "168.63.129.16"
' 205 : RESET CONTENT
' 206 : PARTIAL CONTENT
' 403 : FORBIDDEN
' 410 : RESOURCE GONE
' 429 : TOO MANY REQUESTS
' 500 : INTERNAL SERVER ERROR
' 501 : NOT IMPLEMENTED
' 502 : BAD GATEWAY
' 503 : SERVICE UNAVAILABLE
' 504 : GATEWAY TIMEOUT
' 507 : INSUFFICIENT STORAGE
Const RETRY_CODES = "205 206 403 410 429 500 501 502 503 504 507"
' 410 : RESOURCE GONE
Const RESOURCE_GONE_CODES = "410"
Const REFRESH_GOAL_TIMEOUT_SECONDS = 900 ' 15m
Const RETRY_DELAY_MS = 5000
' 5s pause between retries means 900s (180 * 5 aka 15 minutes)
Const DEFAULT_RETRIES = 180
Dim g_Trace, oTraceEvent
Dim g_Version
Dim g_Initialized
Dim g_goalState
Dim g_objOS
Dim kvp_wireserver_discover_used : kvp_wireserver_discover_used = "provisioning_PA_DiscoverWireServer"
Dim count : count = 0
Set g_goalState = Nothing
Sub Initialize()
Me.WScript.Echo "Initializing WireServer"
Me.ServerAddress = WIRE_SERVER_IP_ADDRESS
Set g_Trace = GetScriptObject(Me.WScript, "Tracing.wsf", "TraceSource")
g_Trace.Name = "WireServer"
Set g_objOS = GetScriptObject(Me.WScript, "OperatingSystem.wsf", "OperatingSystem")
Set g_objOS.WScript = Me.WScript
g_objOS.Initialize
If TraceError(g_Trace, "Initialize: g_objOS.Initialize failed in WireServer") <> 0 Then
Exit Sub
End If
' negotiate the protocol version
NegotiateVersion()
g_Initialized = True
End Sub
Function GetGoalState(maxRetryTimeInSecs)
If g_goalState Is Nothing Then
RefreshGoalState(maxRetryTimeInSecs)
TraceError g_Trace, "GetGoalState: RefreshGoalState failed with ErrNo " & CStr(Err.Number)
End If
Set GetGoalState = g_goalState
End Function
Sub SetFirstGoalStateTime()
Dim kvp_first_goal_state_time : kvp_first_goal_state_time = Me.WScript.Arguments.Named("ConfigurationPass") & "_PA_FirstGoodGoalStateTime"
Dim prevGoalStateTime
prevGoalStateTime = GetKvpRegistry(kvp_first_goal_state_time)
If prevGoalStateTime = "" Then
SetKvpRegistry kvp_first_goal_state_time, g_Trace.GetCurrentTime(), g_Trace
End If
End Sub
Sub RefreshGoalState(maxAttemptTimeInSecs)
On Error Resume Next
If IsEmpty(g_Initialized) Then
Err.Raise vbObjectError + ERROR_NOTINITALIZED, "WireServer.wsf", "Not initialized"
Exit Sub
End If
If IsNull(Me.ServerAddress) Then
Err.Raise vbObjectError + ERROR_NOWIRESERVER, "WireServer.wsf", "Wire server is not available"
Exit Sub
End If
Dim http
Dim httpRequest
Set httpRequest = CreateRequest("GET", "http://" & Me.ServerAddress & "/machine?comp=goalstate", Nothing)
Dim attempt : attempt = 0
Dim retryDelay : retryDelay = 5
Dim startTime : startTime = Now()
Dim status : status = "0"
Dim kvpKey, kvpMessage, endTime
Dim configurationPass : configurationPass = Me.WScript.Arguments.Named("ConfigurationPass")
count = count + 1
kvpKey = "PA_" & configurationPass & "_WireServer_" & count & "_" & httpRequest.verb & "_" & "goalState"
Dim calledTime : calledTime = g_Trace.GetCurrentTime()
Do While (DateDiff("s", startTime, Now()) < maxAttemptTimeInSecs)
attempt = attempt + 1
' attempt to get the goal state
Set http = CloneRequest(httpRequest)
http.send ""
status = CStr(http.status)
If Err.number = 0 Then
TraceResponse http, g_Trace, True
If http.status = 200 Then
endTime = g_Trace.GetCurrentTime()
kvpMessage = "Called=" & calledTime & ";Returned=" & endTime & ";StatusCode=" & status & ";Attempts=" & attempt
SetKvpRegistry kvpKey, kvpMessage, g_Trace
If g_goalState Is Nothing Then
Dim goalState
Set goalState = GetScriptObject(Me.WScript, "WireServer.wsf", "GoalState")
goalState.Initialize Me, http.responseXml
Set g_goalState = goalState
Else
g_goalState.Update http.responseXml
End If
SetFirstGoalStateTime()
Set oTraceEvent = g_Trace.CreateEvent("INFO")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("GoalStateUpdate"))
.setAttribute "version", g_Version
.appendChild(http.responseXml.documentElement.cloneNode(true))
End With
g_Trace.TraceEvent oTraceEvent
Exit Sub
ElseIf IsRetriableStatus(http.status) = False Then
' an unexpected response
endTime = g_Trace.GetCurrentTime()
kvpMessage = "Called=" & calledTime & ";Returned=" & endTime & ";StatusCode=" & status & ";Attempts=" & attempt
SetKvpRegistry kvpKey, kvpMessage, g_Trace
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "Wire server returned an unexpected protocol response (" & CStr(http.status) & ")"
Exit Sub
End If
End If
' the goal state is not yet available or an intermittent failure from the wire server
Set oTraceEvent = g_Trace.CreateEvent("WARN")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("RefreshGoalState"))
If Err.number = 0 Then
.Text = "Retrying wire protocol operation Http Status:" & CStr(http.status)
Else
.Text = "Retrying wire protocol operation HRESULT:" & Hex(Err.number)
Err.Clear
End If
End With
g_Trace.TraceEvent oTraceEvent
Me.WScript.Sleep(RETRY_DELAY_MS)
Loop
endTime = g_Trace.GetCurrentTime()
kvpMessage = "Called=" & calledTime & ";Returned=" & endTime & ";StatusCode=" & status & ";Attempts=" & attempt
SetKvpRegistry kvpKey, kvpMessage, g_Trace
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "Failed to get goal state from wire server after " & attempt & " attempts"
End Sub
Sub PostHealthReport(objHealthReport, sState)
Dim http, headers
On Error Resume Next
Set headers = CreateObject("Scripting.Dictionary")
headers.Add "Content-Type", "text/xml; charset=utf-8"
Set http = CreateRequest("POST", "http://" & Me.ServerAddress & "/machine?comp=health", headers)
SendHttpRequest http, objHealthReport.xml
If TraceError(g_Trace, "PostHealthReport: SendRequest failed") = 0 Then
Dim currHealthReport
Set currHealthReport = GetGoalState(REFRESH_GOAL_TIMEOUT_SECONDS).HealthReport
Set oTraceEvent = g_Trace.CreateEvent("INFO")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("HealthUpdate"))
.setAttribute "version", g_Version
.appendChild(currHealthReport.documentElement.cloneNode(true))
End With
g_Trace.TraceEvent oTraceEvent
End If
End Sub
Sub PostRoleProperties(objRoleProperties)
Dim http, headers
On Error Resume Next
Set headers = CreateObject("Scripting.Dictionary")
headers.Add "Content-Type", "text/xml; charset=utf-8"
Set http = CreateRequest("POST", "http://" & Me.ServerAddress & "/machine?comp=roleProperties", headers)
SendRequest http, objRoleProperties.xml, DEFAULT_RETRIES, Array(200, 202), True
If TraceError(g_Trace, "PostRoleProperties: SendRequest failed") = 0 Then
Set oTraceEvent = g_Trace.CreateEvent("INFO")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("RolePropertiesUpdate"))
.setAttribute "version", g_Version
.appendChild(objRoleProperties.documentElement.cloneNode(true))
End With
g_Trace.TraceEvent oTraceEvent
End If
End Sub
Function GetRoleCertificates(transportCertificateBase64)
Dim xml, httpRequest
On Error Resume Next
If IsEmpty(g_Initialized) Then
Err.Raise vbObjectError + ERROR_NOTINITALIZED, "WireServer.wsf", "Not initialized"
End If
If IsNull(Me.ServerAddress) Then
Err.Raise vbObjectError + ERROR_NOWIRESERVER, "WireServer.wsf", "Wire server is not available"
End If
Dim url, objRoleInstance
Set objRoleInstance = g_goalState.GetRoleInstance()
If objRoleInstance is Nothing Then
' No role instance
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "No role instance in goal state"
Exit Function
End If
url = objRoleInstance.Configuration.Certificates
If IsEmpty(url) Then
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "Goal state does not contain a certificates URL"
Exit Function
End If
Dim requestHeaders : Set requestHeaders = Nothing
If Not IsEmpty(transportCertificateBase64) Then
Set requestHeaders = CreateObject("Scripting.Dictionary")
requestHeaders.Add "x-ms-guest-agent-public-x509-cert", Trim(Replace(transportCertificateBase64, vbCrLf, ""))
End If
Set httpRequest = CreateRequest("GET", url, requestHeaders)
Set xml = SendHttpRequest(httpRequest, "")
If TraceError(g_Trace, "GetRoleCertificates: SendRequest failed") = 0 Then
Set oTraceEvent = g_Trace.CreateEvent("INFO")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("RoleCertificates"))
Dim node
Set node = xml.documentElement.cloneNode(true)
node.selectSingleNode("Data").text = "*SENSITIVE*DATA*DELETED*"
.setAttribute "version", g_Version
.appendChild(node)
End With
g_Trace.TraceEvent oTraceEvent
Set GetRoleCertificates = xml
End If
End Function
Private Sub NegotiateVersion
Dim http, xml
Dim versionElement
Dim wireServerAddress
On Error Resume Next
g_Version = RCP_SUPPORTED_VERSION
wireServerAddress = DiscoverWireserver()
If TraceError(g_Trace, "NegotiateVersion: DiscoverWireserver failed") = 0 Then
Me.ServerAddress = wireServerAddress
Set http = CreateRequest("GET", "http://" & Me.ServerAddress & "/?comp=Versions", Nothing)
Else
' log network information
LogNetworkingData g_Trace
End If
' This request is tried forever because if we cannot communicate with WireServer
' nothing else will work.
Set xml = SendRequest(http, "", -1, Array(200), True)
If TraceError(g_Trace, "NegotiateVersion: SendRequest failed") = 0 Then
Set versionElement = xml.selectSingleNode("/Versions/Supported/Version[text() = '" & RCP_SUPPORTED_VERSION & "']")
If versionElement is Nothing Then
g_Version = Null
Err.Raise vbObjectError + ERROR_NOSUPPORTEDVERSION, "WireServer.wsf", "No compatible wire protocol version"
Exit Sub
Else
g_Version = versionElement.text
Set oTraceEvent = g_Trace.CreateEvent("INFO")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("ControlSystemNegotiation"))
With .appendChild(oTraceEvent.ownerDocument.createElement("Version"))
.Text = g_Version
End With
End With
g_Trace.TraceEvent oTraceEvent
End If
End If
End Sub
Function GetHostingEnvironmentConfig()
Dim http, xml
On Error Resume Next
If IsEmpty(g_Initialized) Then
Err.Raise vbObjectError + ERROR_NOTINITALIZED, "WireServer.wsf", "Not initialized"
End If
If IsNull(Me.ServerAddress) Then
Err.Raise vbObjectError + ERROR_NOWIRESERVER, "WireServer.wsf", "Wire server is not available"
End If
Dim url, objRoleInstance
Set objRoleInstance = g_goalState.GetRoleInstance()
If objRoleInstance is Nothing Then
' No role instance
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "No role instance in goal state"
Exit Function
End If
url = objRoleInstance.Configuration.HostingEnvironmentConfig
If IsEmpty(url) Then
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "Goal state does not contain a hosting environment config URL"
Exit Function
End If
Set http = CreateRequest("GET", url, Nothing)
Set xml = SendHttpRequest(http, "")
If TraceError(g_Trace, "GetHostingEnvironmentConfig: SendHttpRequest failed") = 0 Then
Set GetHostingEnvironmentConfig = xml
End If
End Function
Private Function CreateRequest(verb, url, additionalHeaders)
Dim headers
If ((additionalHeaders Is Nothing) Or IsNull(additionalHeaders) Or IsEmpty(additionalHeaders)) Then
Set headers = CreateObject("Scripting.Dictionary")
Else
Set headers = additionalHeaders
End If
If Not (IsEmpty(g_Version)) Then
headers.Add "x-ms-version", g_Version
End If
headers.Add "x-ms-guest-agent-name", "WaGuest"
Set CreateRequest = CreateHttpRequest(verb, url, headers, 0, 10, 30, 30, g_Trace)
End Function
Sub PutProvisioningStatus(status, substatus, description, properties)
On Error Resume Next
Dim m_objGoalState
Set m_objGoalState = GetGoalState(REFRESH_GOAL_TIMEOUT_SECONDS)
If m_objGoalState Is Nothing Then
TraceError g_Trace, "PutProvisioningStatus: No goal state set"
Exit Sub
End If
If properties Is Nothing Then
m_objGoalState.UpdateRoleState status, substatus, description
TraceError g_Trace, "PutProvisioningStatus: UpdateRoleState failed"
Else
Dim propertyKey, propertyValue
For Each propertyKey In properties.Keys
propertyValue = properties(propertyKey)
m_objGoalState.UpdateRoleProperty propertyKey, propertyValue
TraceError g_Trace, "PutProvisioningStatus: UpdateRoleProperty failed for key-value pair: " & propertyKey & " => " & propertyValue
Next
m_objGoalState.SendRoleProperties
TraceError g_Trace, "PutProvisioningStatus: SendRoleProperties failed"
End If
End Sub
Sub SendTelemetry(operation, message, durationMS)
On Error Resume Next
Const GuestParametersPath = "HKLM\Software\Microsoft\Virtual Machine\Guest\Parameters"
Dim containerId, osVersion, osProductName, winPAVersion, gaVersion
Dim ramSizeMB, logicalProcessorCount, oResults
Dim body, name
Dim headers, http
containerId = GetRegistryValue(g_Trace, GuestParametersPath, "VirtualMachineName", "REG_SZ", True)
winPAVersion = GetWinPAVersion(WshShell, FSO)
name = "WindowsProvisioningAgent"
gaVersion = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\GuestAgent\Incarnation")
If Err.number <> 0 Then
gaVersion = ""
Err.Clear
End If
' e.g. Windows:Windows Server 2016 Datacenter-10.0.14393
osProductName = GetOSProductName
osVersion = GetOSVersion
If TraceError(g_Trace, "SendTelemetry : GetVersion failed") <> 0 Then
osVersion = ""
Else
osVersion = "Windows:" & osProductName & "-" & osVersion
End If
Set oResults = ExecuteAndTraceWithResults("%SystemRoot%\OEM\WaGuest.exe /ram", g_Trace)
If oResults.ExitCode <> 0 Then
ramSizeMB = 0
Else
ramSizeMB = CInt(oResults.StdOut)
End If
logicalProcessorCount = GetNumberOfLogicalProcessors
If TraceError(g_Trace, "SendTelemetry : read logical processors count failed") <> 0 Then
logicalProcessorCount = 0
End If
body = "" & _
"<?xml version=""1.0""?>" & _
"<TelemetryData version=""1.0"">" & _
"<Provider id=""69B669B9-4AF8-4C50-BDC4-6006FA76E975"">" & _
"<Event id=""1"">" & _
"<![CDATA[<Param Name=""ExecutionMode"" Value=""IAAS"" T=""mt:wstr"" />" & _
"<Param Name=""OSVersion"" Value=""" & osVersion & """ T=""mt:wstr"" />" & _
"<Param Name=""GAVersion"" Value=""" & gaVersion & """ T=""mt:wstr"" />" & _
"<Param Name=""RAM"" Value=""" & ramSizeMB & """ T=""mt:int32"" />" & _
"<Param Name=""Processors"" Value=""" & logicalProcessorCount & """ T=""mt:int32"" />" & _
"<Param Name=""OpcodeName"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""KeywordName"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""TenantName"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""RoleName"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""RoleInstanceName"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""ContainerId"" Value=""" & containerId & """ T=""mt:wstr"" />" & _
"<Param Name=""Name"" Value=""" & name & """ T=""mt:wstr"" />" & _
"<Param Name=""Version"" Value=""" & winPAVersion & """ T=""mt:wstr"" />" & _
"<Param Name=""IsInternal"" Value=""False"" T=""mt:bool"" />" & _
"<Param Name=""Operation"" Value=""" & operation & """ T=""mt:wstr"" />" & _
"<Param Name=""OperationSuccess"" Value=""True"" T=""mt:bool"" />" & _
"<Param Name=""ExtensionType"" Value=""" & name & """ T=""mt:wstr"" />" & _
"<Param Name=""Message"" Value=""" & EscapeXml(message) & """ T=""mt:wstr"" />" & _
"<Param Name=""Duration"" Value=""" & CStr(durationMS) & """ T=""mt:int64"" />" & _
"<Param Name=""EventPid"" Value="""" T=""mt:int32"" />" & _
"<Param Name=""EventTid"" Value="""" T=""mt:int32"" />" & _
"<Param Name=""TaskName"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""SubscriptionId"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""ResourceGroupName"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""VMId"" Value="""" T=""mt:wstr"" />" & _
"<Param Name=""ImageOrigin"" Value="""" T=""mt:int32"" />" & "]" & "]>" & _
"</Event>" & _
"</Provider>" & _
"</TelemetryData>"
Set oTraceEvent = g_Trace.CreateEvent("INFO")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("TelemetryData"))
.text = message
.setAttribute "ExecutionMode", "IAAS"
.setAttribute "OSVersion", osVersion
.setAttribute "GAVersion", gaVersion
.setAttribute "RAM", ramSizeMB
.setAttribute "Processors", logicalProcessorCount
.setAttribute "OpcodeName", ""
.setAttribute "KeywordName", ""
.setAttribute "TenantName", ""
.setAttribute "RoleName", ""
.setAttribute "RoleInstanceName", ""
.setAttribute "ContainerId", containerId
.setAttribute "Name", name
.setAttribute "Version", winPAVersion
.setAttribute "IsInternal", "False"
.setAttribute "Operation", operation
.setAttribute "OperationSuccess", "True"
.setAttribute "ExtensionType", name
.setAttribute "Duration",durationMS
.setAttribute "EventPid", ""
.setAttribute "EventTid", ""
.setAttribute "TaskName", ""
.setAttribute "SubscriptionId", ""
.setAttribute "ResourceGroupName", ""
.setAttribute "VMId", ""
.setAttribute "ImageOrigin", ""
End With
g_Trace.TraceEvent oTraceEvent
Set headers = CreateObject("Scripting.Dictionary")
headers.Add "Content-Type", "text/xml; charset=utf-8"
Set http = CreateRequest("POST", "http://" & Me.ServerAddress & "/machine?comp=telemetrydata", headers)
' limit the retries to 3. This is a nice to have, not a required.
SendRequest http, body, 3, Array(200), True
TraceError g_Trace, "SendTelemetry: SendRequest failed"
End Sub
Function GetCertificates()
Dim heConfigXml, xmlCerts
Dim sTransportCertificate, sCertFile
Set heConfigXml = GetHostingEnvironmentConfig()
If heConfigXml Is Nothing Then
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "Failed to obtain hosting environment configuration"
Exit Function
End If
Set xmlCerts = heConfigXml.selectNodes("/HostingEnvironmentConfig/StoredCertificates/StoredCertificate")
If (xmlCerts.length >= 1) Then
' Retrieve contents of pfx blob containing all the StoredCertificates
sTransportCertificate = GetTransportCertificate()
TraceError g_Trace, "GetCertificates: GetTransportCertificate failed"
sCertFile = GetCloudCertificates(sTransportCertificate)
TraceError g_Trace, "GetCertificates: GetCloudCertificates failed"
Dim oCert, roleCerts
Set roleCerts = CreateObject("Scripting.Dictionary")
For Each oCert In xmlCerts
Dim roleCert : Set roleCert = New RoleCertificate
roleCert.thumbprint = oCert.getAttribute("certificateId")
roleCert.storeName = oCert.getAttribute("storeName")
roleCert.name = oCert.getAttribute("name")
roleCert.storeLocation = oCert.getAttribute("configurationLevel")
roleCert.tmpFile = sCertFile
roleCerts.Add roleCert, ""
Next
GetCertificates = roleCerts.Keys
Else
GetCertificates = Null
End If
End Function
' Generates a transport certificate needed to retrieve the stored certificate pfx content for the container
Private Function GetTransportCertificate()
Dim oResults, issuer, objGoalState
On Error Resume Next
Set objGoalState = GetGoalState(REFRESH_GOAL_TIMEOUT_SECONDS)
If objGoalState is Nothing Then
TraceError g_Trace, "GetTransportCertificate: No goal state set"
Exit Function
End If
issuer = objGoalState.Container.ContainerId
Set oResults = ExecuteAndTraceWithResults("%SystemRoot%\OEM\WaGuest.exe /transportcert """ & issuer & """", g_Trace)
If oResults.ExitCode <> 0 Then
Err.Raise vbObjectError + ERROR_TRANSPORTCERTFAILURE, "Certificates.wsf", "Failed to generate a transport certificate (" & oResults.StdErr & ")"
Exit Function
End If
GetTransportCertificate = Trim(Replace(oResults.StdOut, vbCrLf, ""))
End Function
' Retrieves the contents of the pfx containing the stored certificates for the container,
' placing them into a temporary file and returning the absolute path to the file
Private Function GetCloudCertificates(sTransportCert)
Dim certXml, certDataBase64, certFile, certStream
On Error Resume Next
' download the certificates
Set certXml = GetRoleCertificates(sTransportCert)
If certXml is Nothing Then
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "Certificates.wsf", "Failed to obtain certificates"
Exit Function
End If
certDataBase64 = certXml.selectSingleNode("/CertificateFile/Data").text
' write to a temporary file
certFile = CreateTempFile(FSO)
Set certStream = FSO.CreateTextFile(certFile)
certStream.Write certDataBase64
certStream.Close
GetCloudCertificates = certFile
End Function
' Sends an HTTP request to the wireserver, retrying 5 times if necessary and logging the response
Private Function SendHttpRequest(request, body)
On Error Resume Next
Set SendHttpRequest = SendRequest(request, body, DEFAULT_RETRIES, Array(200), True)
TraceError g_Trace, "SendHttpRequest: SendRequest failed"
End Function
' An HTTP request object cannot be re-used. Once it has been "sent" it cannot
' be resent. The solution is to create a representative request, and clone that
' representative requests for any requests you intend to send.
Private Function CloneRequest(httpRequest)
Dim request
Set request = CreateObject("Msxml2.ServerXMLHTTP.3.0")
request.setTimeouts httpRequest.resolveTimeout, httpRequest.connectTimeout, httpRequest.sendTimeout, httpRequest.receiveTimeout
request.open httpRequest.verb, httpRequest.url, FALSE
If Not (IsNull(httpRequest.headers) Or IsEmpty(httpRequest.headers) Or (httpRequest.headers Is Nothing)) Then
Dim header
For Each header In httpRequest.headers.Keys
request.setRequestHeader header, httpRequest.headers.Item(header)
Next
End If
Set CloneRequest = request
End Function
Private Function IsSuccessfulRequest(status, successStatuses)
Dim successStatusesStr : successStatusesStr = Join(successStatuses, " ")
IsSuccessfulRequest = InStr(successStatusesStr, CStr(status)) > 0
End Function
Private Function IsRetriableStatus(status)
IsRetriableStatus = InStr(RETRY_CODES, CStr(status)) > 0
End Function
' A 410 response code indicates that goal state has changed and we have a new incarnation.
Private Function IsResourceGone(status)
IsResourceGone = InStr(RESOURCE_GONE_CODES, CStr(status)) > 0
End Function
Private Function IsRefreshGoalState(status)
IsRefreshGoalState = IsResourceGone(status) = True Or status = 400
End Function
' Sends an HTTP request to the wireserver, retrying if necessary
' Will retry indefinitely if numAttempts < 0
Private Function SendRequest(httpRequest, body, numAttempts, successStatuses, traceResp)
On Error Resume Next
Dim request
Dim attempt : attempt = 0
Dim startTime : startTime = g_Trace.GetCurrentTime()
Dim arrSplit : arrSplit = Split(httpRequest.url, "&")
Dim arr : arr = Split(arrSplit(0), "=")
Dim configurationPass : configurationPass = Me.WScript.Arguments.Named("ConfigurationPass")
Dim status : status = "0"
Dim kvpKey, kvpMessage, endTime, operation
count = count + 1
If UBound(arr) > 0 Then
operation = arr(1)
Else
operation = arr(0)
End If
kvpKey = "PA_" & configurationPass & "_WireServer_" & count & "_" & httpRequest.verb & "_" & operation
Do While (attempt < numAttempts Or numAttempts < 0)
attempt = attempt + 1
Set request = CloneRequest(httpRequest)
request.send body
LogInfo g_Trace, "SendRequest", "attempt=" & CStr(attempt) & ", status=" & CStr(request.status) & ", Err.Number=" & CStr(Err.number)
status = CStr(request.status)
If Err.number = 0 Then
If IsSuccessfulRequest(request.status, successStatuses) = True Then
Set SendRequest = request.responseXml
endTime = g_Trace.GetCurrentTime()
kvpMessage = "Called=" & startTime & ";Returned=" & endTime & ";StatusCode=" & status & ";Attempts=" & attempt
SetKvpRegistry kvpKey, kvpMessage, g_Trace
Exit Function
ElseIf IsRefreshGoalState(request.status) = True Then
RefreshGoalState(REFRESH_GOAL_TIMEOUT_SECONDS)
ElseIf IsRetriableStatus(request.status) = False Then
' an unexpected response
Set SendRequest = Nothing
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "Server returned an unexpected protocol response (" & CStr(request.status) & "). Aborting request and raising error to caller"
endTime = g_Trace.GetCurrentTime()
kvpMessage = "Called=" & startTime & ";Returned=" & endTime & ";StatusCode=" & status & ";Attempts=" & attempt
SetKvpRegistry kvpKey, kvpMessage, g_Trace
Exit Function
End If
End If
' an intermittent failure from the server
If (attempt < numAttempts Or numAttempts < 0) Then
If Err.number = 0 Then
LogWarn g_Trace, "SendRequest", "Received retriable HTTP status: " & CStr(request.status) & " for " & httpRequest.verb & " to " & httpRequest.url & " - attempt(" & attempt & ")"
Else
LogWarn g_Trace, "SendRequest", "Received retriable HTTP client error: " & Hex(Err.Number) & " for " & httpRequest.verb & " to " & httpRequest.url & " - attempt(" & attempt & ")"
Err.Clear
End If
If IsRefreshGoalState(request.status) = True Then
' For requests to URLs contained in the updated goal state, we need to update the URL in the httpRequest argument.
' For requests POSTing health report, we need to update the request body.
Dim objRoleInstance, goalState
Set goalState = GetGoalState(REFRESH_GOAL_TIMEOUT_SECONDS)
Set objRoleInstance = goalState.GetRoleInstance()
If Not (objRoleInstance is Nothing) Then
If InStr(httpRequest.url, "hostingEnvironmentConfig") > 0 Then
httpRequest.url = objRoleInstance.Configuration.HostingEnvironmentConfig
Elseif InStr(httpRequest.url, "sharedConfig") > 0 Then
httpRequest.url = objRoleInstance.Configuration.SharedConfig
Elseif InStr(httpRequest.url, "certificates") > 0 Then
httpRequest.url = objRoleInstance.Configuration.Certificates
Elseif InStr(httpRequest.url, "health") > 0 Then
body = goalState.HealthReport.xml
End If
End If
End If
Me.WScript.Sleep(RETRY_DELAY_MS)
Else
If Err.number = 0 Then
LogError g_Trace, "SendRequest", "Protocol operation failed after " & attempt & " attempts with HTTP status: " & CStr(request.status)
Else
LogError g_Trace, "SendRequest", "Protocol operation failed after " & attempt & " attempts with HRESULT: " & Hex(Err.Number)
Err.Clear
End If
End If
Loop
Set SendRequest = Nothing
endTime = g_Trace.GetCurrentTime()
kvpMessage = "Called=" & startTime & ";Returned=" & endTime & ";StatusCode=" & status & ";Attempts=" & attempt
SetKvpRegistry kvpKey, kvpMessage, g_Trace
Err.Raise vbObjectError + ERROR_PROTOCOLVIOLATION, "WireServer.wsf", "Failed to contact wire server after " & attempt & " attempts"
End Function
' Determines if the wireserver is available or not.
' Returns the address of the wireserver if it's available, null otherwise
Private Function DiscoverWireserver
Dim oResults
Dim pollTime, retries
Dim wireserverEndpointAddress
wireserverEndpointAddress = Null
Dim logOnce
pollTime = 1 's
retries = 30
logOnce = 0
'KVP Diagnostics
Dim kvp_wireserver_lastError, kvp_wireserver_discovery, kvp_wireserver_address, kvpMessage
kvp_wireserver_lastError = Me.WScript.Arguments.Named("ConfigurationPass") & "_PA_WireServer_LastError"
kvp_wireserver_discovery = Me.WScript.Arguments.Named("ConfigurationPass") & "_PA_WireServer_Discovery"
kvp_wireserver_address = Me.WScript.Arguments.Named("ConfigurationPass") & "_PA_WireServer_Address"
SetKvpRegistry kvp_wireserver_discover_used, True, g_Trace
Do While retries > 0
retries = retries - 1
Set oResults = ExecuteAndTraceWithResults("%SystemRoot%\OEM\WaGuest.exe /discover", g_Trace)
If oResults.ExitCode = 0 Then
' wire protocol is available
wireserverEndpointAddress = Trim(Replace(oResults.StdOut, vbCrLf, ""))
If Not IsNull(wireserverEndpointAddress) And Len(wireserverEndpointAddress) <> 0 Then
Dim prevAddress : prevAddress = GetKvpRegistry(kvp_wireserver_address)
If prevAddress <> wireserverEndpointAddress Then
Err.Clear
SetKvpRegistry kvp_wireserver_discovery, "[" & g_Trace.GetCurrentTime() & "]" & ": [DiscoverWireserver] Discover the WireServer address for the first time: " & wireserverEndpointAddress, g_Trace
SetKvpRegistry kvp_wireserver_address, wireserverEndpointAddress, g_Trace
End If
Set oTraceEvent = g_Trace.CreateEvent("INFO")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("DiscoverWireserver"))
.SetAttribute "Address", wireserverEndpointAddress
End With
g_Trace.TraceEvent oTraceEvent
Exit Do
Else
' wireServerAddress is empty
Set oTraceEvent = g_Trace.CreateEvent("ERROR")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("DiscoverWireserver"))
.SetAttribute "Address", wireserverEndpointAddress
End With
g_Trace.TraceEvent oTraceEvent
End If
ElseIf oResults.ExitCode = 3 Then
' wire protocol not currently available - may become available with retries
Set oTraceEvent = g_Trace.CreateEvent("ERROR")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("DiscoverWireserver"))
.Text = "Unable to discover wireserver"
End With
g_Trace.TraceEvent oTraceEvent
' KVP Diagnostics
kvpMessage = "[" & g_Trace.GetCurrentTime() & "]" & ": [DiscoverWireserver] Unable to discover wireserver (" & oResults.StdErr & ")"
SetKvpRegistry kvp_wireserver_discovery, kvpMessage, g_Trace
SetKvpRegistry kvp_wireserver_lastError, kvpMessage, g_Trace
Else
Set oTraceEvent = g_Trace.CreateEvent("ERROR")
With oTraceEvent.appendChild(oTraceEvent.ownerDocument.createElement("DiscoverWireserver"))
.Text = "Failed to initialize the wire protocol (" & oResults.StdErr & ")"
End With
g_Trace.TraceEvent oTraceEvent
' KVP Diagnostics
kvpMessage = "[" & g_Trace.GetCurrentTime() & "]" & ": [DiscoverWireserver] Failed to initialize the wire protocol (" & oResults.StdErr & ")"
SetKvpRegistry kvp_wireserver_discovery, kvpMessage, g_Trace
SetKvpRegistry kvp_wireserver_lastError, kvpMessage, g_Trace
Err.Raise vbObjectError + ERROR_DISCOVERYFAILURE, "GuestInterface.wsf", "Failed to initialize the wire protocol (" & oResults.StdErr & ")"
End If
If logOnce = 0 Then
LogNetworkingData g_Trace
logOnce = 1
End If
Me.WScript.Sleep (pollTime * 1000) 'ms initially retry every 1s for first 30 sec
' Retry every 5sec thereafter
If retries = 0 Then
pollTime = 5 's
retries = 60
logOnce = 0
End If
Loop
DiscoverWireserver = wireserverEndpointAddress
End Function
]]></script>
</component>
<component id="GoalState">
<registration
progid="WaGuest.GoalState"
description=""
version="1.0.0.0"
clsid="{C48DDCC0-4D3C-4DDF-8BED-E39D8A25E73E}"/>
<public>
<method name="Initialize">
<parameter name="Parent" />
<parameter name="Xml" />
</method>
<method name="Update">
<parameter name="Xml" />
</method>
<method name="UpdateRoleState">
<parameter name="sState" />
<parameter name="sSubStatus" />
<parameter name="sDescription" />
</method>
<method name="UpdateRoleProperty">
<parameter name="sPropertyName" />
<parameter name="sPropertyValue" />
</method>
<method name="SendRoleProperties"/>
<method name="GetRoleInstance"/>
<property name="Incarnation"><get /></property>
<property name="MachineExpectedState"><get /></property>
<property name="Container"><get /></property>
<property name="HealthReport"><get /></property>
</public>
<object id="WshShell" progid="WScript.Shell" />
<script language="VBScript"><![CDATA[
Dim m_Parent
Dim g_Incarnation
Dim g_MachineExpectedState
Dim g_Container
Dim m_objHealthReport
Dim m_objRoleProperties
Public Sub Initialize(parent, xml)
Dim gsElement
Set m_Parent = parent
' parse goal state to extract salient details
set gsElement = xml.selectSingleNode("/GoalState")
g_Incarnation = gsElement.selectSingleNode("Incarnation").text
g_MachineExpectedState = gsElement.selectSingleNode("Machine/ExpectedState").text
Set g_Container = new Container
g_Container.Initialize gsElement.selectSingleNode("Container")
Call InitializeHealthReport
Call InitializeRoleProperties
End Sub
Public Sub Update(xml)
Dim gsElement
set gsElement = xml.selectSingleNode("/GoalState")
g_Incarnation = gsElement.selectSingleNode("Incarnation").text
g_MachineExpectedState = gsElement.selectSingleNode("Machine/ExpectedState").text
Set g_Container = new Container
g_Container.Initialize gsElement.selectSingleNode("Container")
Call UpdateHealthReport
End Sub
Public Function get_Incarnation
get_Incarnation = g_Incarnation
End Function
Public Function get_MachineExpectedState
get_MachineExpectedState = g_MachineExpectedState
End Function
Public Function get_Container
Set get_Container = g_Container
End Function
Public Function get_HealthReport
Set get_HealthReport = m_objHealthReport
End Function
Private Sub InitializeHealthReport()
' generate a template that will be updated over time
Set healthReport = CreateObject( "Microsoft.XMLDOM" )
With healthReport.appendChild(healthReport.createElement("Health"))
With .appendChild(healthReport.createElement("GoalStateIncarnation"))
.Text = g_Incarnation
End With
With .appendChild(healthReport.createElement("Container"))
With .appendChild(healthReport.createElement("ContainerId"))
.Text = g_Container.ContainerId
End With
With .appendChild(healthReport.createElement("RoleInstanceList"))
For Each objRoleInstance in g_Container.RoleInstances
With .appendChild(healthReport.createElement("Role"))
With .appendChild(healthReport.createElement("InstanceId"))
.Text = objRoleInstance.InstanceId
End With
With .appendChild(healthReport.createElement("Health"))
With .appendChild(healthReport.createElement("State"))
.Text = "Ready"
End With
End With
End With
Next
End With
End With
End With
Set m_objHealthReport = healthReport
End Sub
Private Sub UpdateHealthReport()
Dim objHealth, objGoalStateIncarnation
On Error Resume Next
Set objHealth = m_objHealthReport.selectSingleNode("/Health")
If objHealth Is Nothing Then
Err.Raise 7, "WireServer.wsf", "GoalState.UpdateHealthReport: No Health root found"
Exit Sub
End If
Set objGoalStateIncarnation = objHealth.selectSingleNode("GoalStateIncarnation")
If objGoalStateIncarnation Is Nothing Then
Err.Raise 8, "WireServer.wsf", "GoalState.UpdateHealthReport: No GoalStateIncarnation found in health report"
Exit Sub
End If
objGoalStateIncarnation.Text = g_Incarnation
End Sub
Public Sub UpdateRoleState(sState, sSubStatus, sDescription)
Dim objHealth, objState, objDetails
Dim objRoleInstance
On Error Resume Next
Set objRoleInstance = GetRoleInstance()
If objRoleInstance is Nothing Then
' No role instance
Err.Raise 5, "WireServer.wsf", "No role instance in goal state"
Exit Sub
End If
' select the relevant instance health
Set objHealth = m_objHealthReport.selectSingleNode("/Health/Container/RoleInstanceList/Role[InstanceId='" & objRoleInstance.InstanceId & "']/Health")
If objHealth is Nothing Then
Err.Raise 6, "WireServer.wsf", "No such role instance"
Exit Sub
End If
' update the state element
Set objState = objHealth.selectSingleNode("State")
objState.Text = sState
' update the details element
Set objDetails = objHealth.selectSingleNode("Details")
If Not(objDetails is Nothing) Then
objHealth.removeChild objDetails
End If
If sState = "NotReady" Then
With objHealth.appendChild(m_objHealthReport.createElement("Details"))
With .appendChild(m_objHealthReport.createElement("SubStatus"))
.Text = sSubStatus
End With
With .appendChild(m_objHealthReport.createElement("Description"))
.Text = sDescription
End With
End With
End If
m_Parent.PostHealthReport m_objHealthReport, sState
End Sub
Private Sub InitializeRoleProperties
' generate a template that will be updated over time
set objRoleProperties = CreateObject( "Microsoft.XMLDOM" )
With objRoleProperties.appendChild(objRoleProperties.createElement("RoleProperties"))
With .appendChild(objRoleProperties.createElement("Container"))
With .appendChild(objRoleProperties.createElement("ContainerId"))
.Text = g_Container.ContainerId
End With
With .appendChild(objRoleProperties.createElement("RoleInstances"))
For Each objRoleInstance in g_Container.RoleInstances
With .appendChild(objRoleProperties.createElement("RoleInstance"))
With .appendChild(objRoleProperties.createElement("Id"))
.Text = objRoleInstance.InstanceId
End With
With .appendChild(objRoleProperties.createElement("Properties"))
End With
End With
Next
End With
End With
End With
Set m_objRoleProperties = objRoleProperties
End Sub
Public Sub UpdateRoleProperty(sPropertyName, sPropertyValue)
Dim objRI, objProps, objProp
Dim objRoleInstance
On Error Resume Next
Set objRoleInstance = GetRoleInstance()
If objRoleInstance is Nothing Then
' No role instance
Err.Raise 5, "WireServer.wsf", "No role instance in goal state"
Exit Sub
End If
' select the relevant instance
Set objRI = m_objRoleProperties.selectSingleNode("/RoleProperties/Container/RoleInstances/RoleInstance[Id='" & objRoleInstance.InstanceId & "']")
If objRI is Nothing Then
Err.Raise 6, "WireServer.wsf", "No such role instance"
Exit Sub
End If
' select the properties element
Set objProps = objRI.selectSingleNode("Properties")
If objProps is Nothing Then
Set objProps = m_objRoleProperties.createElement("Properties")
objRI.appendChild objProps
End If
' select the property
Set objProp = objProps.selectSingleNode("Property[@name='" & sPropertyName & "']")
If objProp is Nothing Then
Set objProp = m_objRoleProperties.createElement("Property")
objProp.setAttribute "name", sPropertyName
objProps.appendChild objProp
End If
' set the property value
objProp.setAttribute "value", sPropertyValue
End Sub
Public Sub SendRoleProperties
Dim objClone
Dim objR, objExcludes, objRI
Dim objRoleInstance
On Error Resume Next
Set objRoleInstance = GetRoleInstance()
If objRoleInstance is Nothing Then
' No role instance
Err.Raise 5, "WireServer.wsf", "No role instance in goal state"
Exit Sub
End If
' clone the document, then strip out other role instances
set objClone = CreateObject( "Microsoft.XMLDOM" )
m_objRoleProperties.save objClone
Set objR = objClone.selectSingleNode("/RoleProperties/Container/RoleInstances")
Set objExcludes = objClone.selectNodes("/RoleProperties/Container/RoleInstances/RoleInstance[not(Id='" & objRoleInstance.InstanceId & "')]")
For Each objRI in objExcludes
objR.removeChild objRI
Next
' post the clone
objClone.documentElement.normalize()
m_Parent.PostRoleProperties objClone
End Sub
Public Function GetRoleInstance
Dim m_objRoleInstance
Set GetRoleInstance = Nothing
' select the first role instance
For Each m_objRoleInstance in g_Container.RoleInstances
Set GetRoleInstance = m_objRoleInstance
Exit For
Next
End Function
Class Container
Private m_ContainerId
Private m_RoleInstances()
Public Property Get ContainerId
ContainerId = m_ContainerId
End Property
Public Property Get RoleInstances
RoleInstances = m_RoleInstances
End Property
Sub Initialize(containerElement)
m_ContainerId = containerElement.selectSingleNode("ContainerId").text
Dim count
count = 0
For Each rElement In containerElement.selectNodes("RoleInstanceList/RoleInstance")
Dim roleInstance
Set roleInstance = new RoleInstance
roleInstance.Initialize(rElement)
count = count + 1
ReDim Preserve m_RoleInstances(count - 1)
Set m_RoleInstances(count - 1) = roleInstance
Next
End Sub
End Class
Class RoleInstance
Private m_InstanceId
Private m_State
Private m_Configuration
Public Property Get InstanceId
InstanceId = m_InstanceId
End Property
Public Property Get State
State = m_State
End Property
Public Property Get Configuration
Set Configuration = m_Configuration
End Property
Sub Initialize(roleInstanceElement)
m_InstanceId = roleInstanceElement.selectSingleNode("InstanceId").text
m_State = roleInstanceElement.selectSingleNode("State").text
Set m_Configuration = new RoleInstanceConfiguration
m_Configuration.Initialize(roleInstanceElement.selectSingleNode("Configuration"))
End Sub
End Class
Class RoleInstanceConfiguration
' If there is new url added to this configuration like fullConfig or extension config then that needs to be added in sendrequest retry method as well
Private m_HostingEnvironmentConfig
Private m_SharedConfig
Private m_Certificates
Public Property Get HostingEnvironmentConfig
HostingEnvironmentConfig = m_HostingEnvironmentConfig
End Property
Public Property Get SharedConfig
SharedConfig = m_SharedConfig
End Property
Public Property Get Certificates
Certificates = m_Certificates
End Property
Sub Initialize(configurationElement)
m_HostingEnvironmentConfig = configurationElement.selectSingleNode("HostingEnvironmentConfig").text
m_SharedConfig = configurationElement.selectSingleNode("SharedConfig").text
If Not (configurationElement.selectSingleNode("Certificates") is Nothing) Then
m_Certificates = configurationElement.selectSingleNode("Certificates").text
End If
End Sub
End Class
]]></script>
</component>
</package>