IIS WarmUp Part II

IIS WarmUp Part II

I explained in my earlier post the importance of “warming up” your sites in IIS, especially using the latest .Net frameworks.

Here is a major update to the code posted in that post.

This one will allow you to “warm up” every site in IIS on your server. All you have to do is set the version of IIS to 7 or 6 depending on your install, and then run the program. You could also set the allApplications flag to false and put in the selected sites to “warm up”. Please understand, because of the access needed to warm up all of your sites, this program needs to run under an Administrator account. (it accesses IIS’s metabase files)

So, without too much blab, and without any further ado… here’s the code.

Settings.xml

<Settings>
 <Config>
 <!-- Set your IIS version, and whether or no you want to "warm up" all sites -->
 <IIS version="7" allApplications="True">
 <!-- This is a list of sites to warm up, only comes into play if you have the allApplications flag set to false -->
 <Site url="http://www.o7thwebdesign.com" page="/" />
 <Site url="http://www.facchinifacchinipa.com" page="/" />
 <Site url="http://skor.in" page="/" />
 <Site url="http://o7t.in" page="/" />
 </IIS>
 </Config>
</Settings>

AuditManager.vb

Public Class AuditManager

 'The type of audit to write out
 Public Enum AuditType
 Exception
 General
 End Enum

 'Write the audit to the log file
 Public Shared Sub Write(ByVal _Type As AuditType?, ByVal _Description As String, Optional ByVal _Location As String = Nothing, Optional ByVal _Except As Exception = Nothing)
 Dim _Stack As System.Diagnostics.StackTrace
 If _Except IsNot Nothing Then
 _Stack = New System.Diagnostics.StackTrace(_Except, True)
 Else
 _Stack = Nothing
 End If
 Using _F As New IO.StreamWriter(Common.GetPath() & FormatDateTime(Date.Now, DateFormat.ShortDate).Replace("/", String.Empty) & ".LOG", True)
 Dim tmpString As New Text.StringBuilder
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("WHEN:" & vbCrLf)
 tmpString.Append(Date.Now & vbCrLf)
 If _Type.HasValue Then
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("TYPE:" & vbCrLf)
 tmpString.Append([Enum].GetName(GetType(AuditType), _Type) & vbCrLf)
 End If
 If _Location IsNot Nothing Then
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("LOCATION:" & vbCrLf)
 tmpString.Append(_Location & vbCrLf)
 End If
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 If _Stack IsNot Nothing Then
 tmpString.Append("STACKTRACE:" & vbCrLf)
 tmpString.Append(_Stack.ToString() & vbCrLf)
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("STACK FRAMES:" & vbCrLf)
 For Each frame In _Stack.GetFrames()
 tmpString.Append(" - FILE:" & frame.GetFileName() & vbCrLf)
 tmpString.Append(" - METHOD:" & frame.GetMethod().Name & vbCrLf)
 tmpString.Append(" - LINE:" & frame.GetFileLineNumber() & vbCrLf)
 tmpString.Append(" - COLUMN:" & frame.GetFileColumnNumber() & vbCrLf)
 Next
 End If
 If _Except IsNot Nothing Then
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("SOURCE:" & vbCrLf)
 tmpString.Append(_Except.Source & vbCrLf)
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("MESSAGE:" & vbCrLf)
 tmpString.Append(_Except.Message & vbCrLf)
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("DATA:" & vbCrLf)
 tmpString.Append(_Except.Data.ToString() & vbCrLf)
 End If
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 tmpString.Append("NOTES:" & vbCrLf)
 tmpString.Append(_Description & vbCrLf)
 tmpString.Append("-------------------------------------------------" & vbCrLf)
 _F.Write(tmpString.ToString())
 _F.Close()
 End Using
 End Sub

End Class

Common.vb

Public Class Common

 'The applications path
 Public Shared Function GetPath() As String
 Return System.AppDomain.CurrentDomain.BaseDirectory()
 End Function

 'Check to see if a value is Null, if so, set it to equal a default value
 Public Shared Function IsNull(Of T)(ByVal Value As T, ByVal _Default As T) As T
 If Not (IsDBNull(Value)) OrElse Value IsNot Nothing OrElse Not (Value.ToString.Length > 0) Then
 Return DirectCast(Value, T)
 Else
 Return DirectCast(_Default, T)
 End If
 End Function

End Class

CustomCache.vb

Imports System.Runtime.Caching

''' <summary>
''' Our Provider
''' </summary>
''' <remarks></remarks>
Public Interface ICacheProvider
 Function GetItem(Of T)(ByVal key As String) As T
 Sub SetItem(ByVal data As Object, ByVal key As String)
 Sub Remove(ByVal key As String)
 Sub Clear()
End Interface

''' <summary>
''' Our Custom Caching Object
''' </summary>
''' <remarks></remarks>
Public Class CustomCache
 Implements ICacheProvider

 ''' <summary>
 ''' The Cache Object
 ''' </summary>
 ''' <value></value>
 ''' <returns></returns>
 ''' <remarks></remarks>
 Private ReadOnly Property Cache() As ObjectCache
 Get
 Return MemoryCache.Default
 End Get
 End Property

 ''' <summary>
 ''' Set the cache Item
 ''' </summary>
 ''' <param name="key"></param>
 ''' <param name="data"></param>
 ''' <remarks></remarks>
 Public Sub SetCacheItem(ByVal data As Object, ByVal key As String) Implements ICacheProvider.SetItem
 Dim policy As New CacheItemPolicy()
 policy.AbsoluteExpiration = DateTime.Now.AddHours(24)
 Cache.Add(New CacheItem(key, data), policy)
 End Sub

 ''' <summary>
 ''' Get the Cache Item
 ''' </summary>
 ''' <typeparam name="T"></typeparam>
 ''' <param name="key"></param>
 ''' <returns></returns>
 ''' <remarks></remarks>
 Public Function GetCacheItem(Of T)(ByVal key As String) As T Implements ICacheProvider.GetItem
 Return DirectCast(Cache(key), T)
 End Function

 ''' <summary>
 ''' Remove the Item from Cache
 ''' </summary>
 ''' <param name="key"></param>
 ''' <remarks></remarks>
 Public Sub RemoveItem(ByVal key As String) Implements ICacheProvider.Remove
 Cache.Remove(key)
 End Sub

 ''' <summary>
 ''' Remove All items from Cache
 ''' </summary>
 ''' <remarks></remarks>
 Public Sub ClearCache() Implements ICacheProvider.Clear
 For Each item In Cache
 Cache.Remove(item.Key)
 Next
 End Sub

End Class

Settings.vb

Public Class Settings

 Private Shared Cache As New CustomCache

 'Grab our settings file
 Private Shared ReadOnly Property SettingDoc As XDocument
 Get
 Dim _C As XDocument = Cache.GetCacheItem(Of XDocument)("Settings")
 If _C IsNot Nothing Then
 Return _C
 Else
 Return XDocument.Load(Common.GetPath() & "Settings.xml")
 End If
 End Get
 End Property

 'Get and set all our settings
 Public Shared Function GetSettings() As List(Of Typing.Settings.Settings)
 Dim _Qry As New List(Of Typing.Settings.Settings)
 _Qry = (From n In SettingDoc...<IIS>.AsParallel()
 Select New Typing.Settings.Settings() With {
 .IisVersion = Common.IsNull(Of Integer)(n.@version, 0),
 .PrimeAll = Common.IsNull(Of Boolean)(n.@allApplications, True),
 .Sites = Common.IsNull(Of List(Of Typing.Settings.Sites))((From s In n.<Site>.AsParallel()
 Select New Typing.Settings.Sites() With {
 .Url = s.@url,
 .Page = s.@page
 }).ToList(), Nothing)
 }).ToList()
 If _Qry IsNot Nothing Then
 Return _Qry
 Else
 Return Nothing
 End If
 _Qry.Clear()
 End Function

End Class

Typing.vb

'Strongly Type all our values
Public Class Typing

 Partial Public Class Settings

 Partial Public Class Settings
 Public Property IisVersion As Integer
 Public Property PrimeAll As Boolean
 Public Property Sites As List(Of Sites)
 End Class

 Partial Public Class Sites
 Public Property Url As String
 Public Property Page As String
 End Class

 End Class

 Partial Public Class MetaBase
 Public Property Protocol As String
 Public Property Binding As String
 End Class

End Class

WarmUpService.vb

Imports System.Threading.Tasks
Imports System.Security.Principal

Module WarmUpService

 'Check and make sure we have Admin Privelages
 Private ReadOnly Property HasAdminPrivelages()
 Get
 Dim _Id = WindowsIdentity.GetCurrent()
 Dim _Prin = New WindowsPrincipal(_Id)
 Return _Prin.IsInRole(WindowsBuiltInRole.Administrator)
 End Get
 End Property

 'Fire It Up!
 Public Sub Main()
 If HasAdminPrivelages() Then
 AuditManager.Write(AuditManager.AuditType.General, "Fireing Up...")
 DoTheWarmUp()
 AuditManager.Write(AuditManager.AuditType.General, "All Set...")
 Else
 MsgBox("You need to be an administrator in order to run this.")
 End If
 End Sub

 Private Sub DoTheWarmUp()
 Try
 Dim _Set As List(Of Typing.Settings.Settings) = Settings.GetSettings()
 If _Set IsNot Nothing Then
 If _Set(0).PrimeAll Then
 Select Case _Set(0).IisVersion
 Case 6 ' IIS 6
 Dim _PT As New Iis6Primer()
 _PT.PrimeThem()
 Case 7 ' IIS 7 & IIS 7.5
 Dim _PT As New Iis7Primer()
 _PT.PrimeThem()
 Case Else
 AuditManager.Write(AuditManager.AuditType.Exception, "There was an issue! Unsupported IIS version.", "DoTheWarmUp")
 End Select
 Else
 Dim _Sites As List(Of Typing.Settings.Sites) = _Set.Item(0).Sites
 If _Sites IsNot Nothing Then
 Parallel.ForEach(_Sites, Sub(Item)
 Primer.GrabEm(Item.Url & Item.Page)
 End Sub)
 _Sites.Clear()
 End If
 _Set.Clear()
 End If
 Else
 AuditManager.Write(AuditManager.AuditType.Exception, "There was an issue! There are no settings.", "DoTheWarmUp")
 End If
 Catch ex As Exception
 AuditManager.Write(AuditManager.AuditType.Exception, "There was an issue!", "DoTheWarmUp", ex)
 End Try
 End Sub

End Module

Primer.vb

Imports System.Net
Imports System.Reflection

Public Class Primer

 Public Shared Sub GrabEm(ByVal _SitePath As String)
 Try
 SetAllowUnsafeHeaderParsing20()
 Using _WC As New WebClient()
 _WC.Headers.Add("user-agent", "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13")
 _WC.DownloadData(_SitePath)
 End Using
 AuditManager.Write(AuditManager.AuditType.General, "Site: " & _SitePath & " Is Now Primed!")
 Catch ex As Exception
 AuditManager.Write(AuditManager.AuditType.Exception, "Issue with the site: " & _SitePath & ".", "GrabEm", ex)
 End Try
 End Sub

 Private Shared Sub SetAllowUnsafeHeaderParsing20()
 Dim a As New System.Net.Configuration.SettingsSection
 Dim aNetAssembly As System.Reflection.Assembly = Assembly.GetAssembly(a.GetType)
 Dim aSettingsType As Type = aNetAssembly.GetType("System.Net.Configuration.SettingsSectionInternal")
 Dim args As Object() = Nothing
 Dim anInstance As Object = aSettingsType.InvokeMember("Section", BindingFlags.Static Or BindingFlags.GetProperty Or BindingFlags.NonPublic, Nothing, Nothing, args)
 Dim aUseUnsafeHeaderParsing As FieldInfo = aSettingsType.GetField("useUnsafeHeaderParsing", BindingFlags.NonPublic Or BindingFlags.Instance)
 aUseUnsafeHeaderParsing.SetValue(anInstance, True)
 End Sub

End Class

Iis6Primer.vb

Imports <xmlns="urn:microsoft-catalog:XML_Metabase_V64_0">
Imports System.Threading.Tasks

Public Class Iis6Primer

 Private _Xml As XDocument
 Dim _Qry As New List(Of Typing.MetaBase)

 Public Sub New()
 Dim _MetaBasePath As String = Environment.GetFolderPath(Environment.SpecialFolder.System) & "inetsrv"
 _MetaBasePath += "metabase.xml"
 _Xml = XDocument.Load(_MetaBasePath, LoadOptions.PreserveWhitespace)
 _Qry = (From n In _Xml...<IIsWebServer>
 Where (n.@ServerBindings IsNot Nothing)
 Select New Typing.MetaBase() With {
 .Binding = Common.IsNull(Of String)(n.@ServerBindings, String.Empty)
 }).ToList()
 End Sub

 Public Sub PrimeThem()
 Dim _Binding, _Url, _T
 Parallel.ForEach(_Qry, Sub(Item)
 _Binding = Item.Binding
 If _Binding.Contains(" ") Then
 _Binding = _Binding.Replace(" ", "|")
 _T = _Binding.Split("|")
 For Each i In _T
 _Url = i.Split(":")
 If _Url(1).Contains("80") Then
 Primer.GrabEm("http://" & _Url(_Url.GetUpperBound(0)))
 End If
 Next
 Else
 _Url = _Binding.Split(":")
 If _Url(1).Contains("80") Then
 Primer.GrabEm("http://" & _Url(_Url.GetUpperBound(0)))
 End If
 End If
 End Sub)
 _Qry.Clear()
 End Sub

End Class

Iis7Primer.vb

Imports System.Threading.Tasks

Public Class Iis7Primer

 Private _Xml As XDocument
 Dim _Qry As New List(Of Typing.MetaBase)

 Public Sub New()
 Dim _MetaBasePath As String = Environment.GetFolderPath(Environment.SpecialFolder.System) & "inetsrv"
 _MetaBasePath += "configapplicationHost.config"
 _Xml = XDocument.Load(_MetaBasePath, LoadOptions.PreserveWhitespace)
 _Qry = (From n In _Xml...<binding>.AsParallel()
 Select New Typing.MetaBase() With {
 .Binding = Common.IsNull(Of String)(n.@bindingInformation, String.Empty),
 .Protocol = Common.IsNull(Of String)(n.@protocol, String.Empty)
 }).ToList()
 End Sub

 Public Sub PrimeThem()
 Dim _Prot, _Binding, _Url
 Parallel.ForEach(_Qry, Sub(i)
 _Prot = i.Protocol
 If _Prot = "http" Then
 _Binding = i.Binding
 _Url = _Binding.Split(":")
 Primer.GrabEm("http://" & _Url(_Url.GetUpperBound(0)))
 End If
 End Sub)
 _Qry.Clear()
 End Sub

End Class