Posted: April 18, 2012
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