CL1 webserver: <Anantsystems>  <Ad info>       related sites: <FREE Help> <ASP> <Asp.net> <worldwide>   feedback: <lovethat> <hatethat> <thanks> <credits> <contact us>

Checking Health of Server

Our server's health is based on more than just simple indicators. We built this script to monitor many things. It is called by a monitor service that will reboot if it does not see "server OK".

<Test Script Below>

<!--#include virtual="/library/lib_toc.asp"-->
<%
'on error resume next
dim badnews,cluster,goodnews,serverhealthy,healthbefore
cluster=whichserver()
response.write cluster
application("testcounter")=application("testcounter")+1
' test email
somailtest=somailhealth()
serverHealthy=True
If  instr(somailtest,"server OK")>0 THEN
   serverhealthy=True
   goodnews=goodnews & somailtest & "<br>"
ELSE
   serverhealthy=False
   badnews=badnews & somailtest & "<br>"
END IF

'Call AccessTestMany

If  serverhealthy=True THEN
   response.write ("<br>server OK<br>")
   response.write "<hr><br>"
   Call ServerRestartDisplay

   response.write "<br><br>"
   response.write "Server Test Counter=" & application("testcounter") & "<br>"
   response.write "Lyris Test Mails=" & application("lyrismailtestcounter") & "<br>"
   response.write "<B>WHAT WAS TESTED:<br>"
   response.write goodnews
'   response.write "<br>Note: " & LyrisTest()
'   response.write "<br>Note: " & tempAcc
   response.write "<br>Note: " & DataUseful()
   response.write "<br>Note: " &   appvarstest()
   response.write "<br>Note: " &   DiskspaceTest()

ELSE
   response.write ("<br>server NOT OK<br>")
   response.write "<hr><br><br>"
   response.write "<B>UGLY DETAILS:<br>"
   response.write badnews
END IF

SUB Accesstest
   ' test Biblio
   bibliotest=Accesshealth("/learn/test/biblio.mdb")
   If instr(bibliotest,"Access OK")>0 THEN
   serverhealthy=True
   goodnews=goodnews & bibliotest & "<br>"
   ELSE
   serverhealthy=False
   badnews=badnews & bibliotest & "<br>"
   END IF

   ' test nwind
   nwindtest=Accesshealth("/learn/test/nwind.mdb")
   If instr(nwindtest,"Access OK")>0 THEN
   serverhealthy=True
   goodnews=goodnews & nwindtest & "<br>"
   ELSE
   serverhealthy=False
   badnews=badnews & nwindtest & "<br>"
   END IF

' test ELI data
'   elitest=Accesshealth("D:\database\Eli.mdb")
'   If instr(elitest,"Access OK")>0 THEN
'   serverhealthy=True
'   goodnews=goodnews & elitest & "<br>"
'   ELSE
'   serverhealthy=False
'   badnews=badnews & elitest & "<br>"
'   END IF
END SUB

SUB AccessTestMany
   healthbefore=serverhealthy
   Call AccessTest
   If application("msaccessfailed")="" THEN
      application("msaccessfailed")=0
   END IF
   If application("failedsequence")="" THEN
      application("failedsequence")=0
   END IF
   laststatus=application("failedsequence")
   If serverhealthy=False AND serverhealthy<>healthbefore THEN
      application.lock
      application("msaccessfailed")=application("msaccessfailed")+1
      application("msaccessattempted")=application("msaccessattempted")+1
      application.unlock
      application("failedsequence")=application("failedsequence")+1
   END IF
   If serverhealthy=False AND serverhealthy=healthbefore THEN
      application.lock
      application("msaccessfailed")=application("msaccessfailed")-1
      application("msaccessattempted")=application("msaccessattempted")+1
      application.unlock
      application("failedsequence")=application("failedsequence")+1
   END IF
   If serverhealthy=True THEN
      application.lock
      application("msaccessattempted")=application("msaccessattempted")+1
      application.unlock
      IF application("msaccess")=1 THEN
         application.lock
         application("msaccessfailed")=application("msaccessfailed")-1
         application.unlock
      END IF
   application("failedsequence")=0
   END IF
   serverhealthy=healthbefore
   ratio=application("msaccessfailed")/application("msaccessattempted")
   tempAcc="MSAccess failed " & application("failedsequence") & " times sequentially and <b>" & application("msaccessfailed") & "/" & application("msaccessattempted") & "</b> in total.<br>"
   IF application("failedsequence")>3 THEN
      serverhealthy=false
      badnews=badnews & tempAcc
   END IF
END SUB

FUNCTION AppVarsTest
   FOR EACH key IN application.contents
      key=lcase(key)
      allvars=allvars & vbclrf & key
   NEXT
   separator=""
   appvarprob=""
   IF instr(allvars,"generated_zlearnzlearnztoc")=0 THEN
      appvarprob="\learn"
      separator=", "
      'call TOCpretty("\learn\learn.toc")
   END IF
   IF instr(allvars,"generated_zcommunityzcommunityztoc")=0 THEN
      appvarprob=appvarprob & separator & "\community"
      separator=", "
      'call TOCpretty("\community\community.toc")
   END IF
   IF instr(allvars,"generated_zarticleszarticlesztoc")=0 THEN
      appvarprob=appvarprob & separator & "\articles"
      separator=", "
      'call TOCpretty("\articles\articles.toc")
   END IF
   IF instr(allvars,"generated_zasplistszasplistsztoc")=0 THEN
      appvarprob=appvarprob & separator & "\asplists"
      separator=", "
      'call TOCpretty("\asplists\asplists.toc")
   END IF
   IF instr(allvars,"generated_zbookszbooksztoc")=0 THEN
      appvarprob=appvarprob & separator & "\books"
      separator=", "
      'call TOCpretty("\books\books.toc")
   END IF
   IF instr(allvars,"generated_zaspazcomponentszcomponentsztoc")=0 THEN
      appvarprob=appvarprob & separator & "\components"
      separator=", "
      'call TOCpretty("\aspa\components\components.toc")
   END IF
   IF instr(allvars,"generated_zadvicezadviceztoc")=0 THEN
      appvarprob=appvarprob & separator & "\advice"
      separator=", "
      'call TOCpretty("\advice\advice.toc")
   END IF
   IF instr(allvars,"generated_zscottmitchellzscottmitchellztoc")=0 THEN
      appvarprob=appvarprob & separator & "\scottmitchell"
      'call TOCpretty("\scottmitchell\scottmitchell.toc")
   END IF
   IF len(appvarprob)=0 THEN
      AppVarsTest="<b>Apps Marked CORRECTLY</b><br>"
   ELSE
      AppVarsTest="<b><font color='red'>Apps NOT marked correctly</b></font><br>" & appvarprob
   END IF
END FUNCTION

FUNCTION DiskspaceTest()
   Dim fs, d,freespace
       Set fs = server.CreateObject("Scripting.FileSystemObject")
       Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName("/index.aspx")))
       freespace=d.availablespace
       freespacepretty=formatnumber(freespace/(1024*1000),0) & " megs"
       If freespace>50000000 THEN
          DiskSpaceTest="<b>FREE Disk Space is fine " & freespacepretty & "</b>"
       ELSE
          DiskSpaceTest="<b><font color='red'>FREE Disk Problem " & freespacepretty & "</b>"
       END IF
       set d=nothing
       set fs=nothing
END FUNCTION

FUNCTION SoMailHealth()
   Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
   Mailer.RemoteHost = "localhost"

   Mailer.FromName = "Monitor"
   Mailer.FromAddress = "librarymonitorcomponents@learnasp.com"
   Mailer.AddRecipient "Charles Carroll","selfdestruct@learnasp.com"
   Mailer.Subject = "/library/monitorcomponents.asp"

   Mailer.BodyText = "Line 1" & vbCrLf
   Mailer.BodyText = "Line 2" & vbCrLf
   Mailer.BodyText = "Line 3"
   If Mailer.SendMail then
      SOMailHealth= "server OK: <b>SMTPsvg.Mailer</b>"
   Else
      SOMailHealth = "server not OK: <b>SMTPsvg.Mailer " & mailer.response & "</b>"
   End If
   set mailer=nothing
END FUNCTION


FUNCTION LyrisTest()
   ' Lyris Test Message
   IF    application("testcounter") MOD 5 = 0 THEN
      application("lyrismailtestcounter")=application("lyrismailtestcounter")+1
   ELSE
      EXIT FUNCTION
   END IF

   Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
   Mailer.RemoteHost = "localhost"

   dim fromrandom, randomhost, randomaddress
   randomize
   fromrandom="darthcarroll" & int(rnd*10000)+1 & "@asplists.com"
   randomhost=int(rnd*9)+1
   SELECT CASE randomhost
      CASE 1
         randomaddress="test@ls.asplists.com"

      CASE 2
         randomaddress="test@aspfriends.com"
      CASE 3
         randomaddress="test@trusted.aspfriends.com"

      CASE 4
         randomaddress="test@aspfriend.com"
      CASE 5
         randomaddress="test@trusted.aspfriend.com"

      CASE 6
         randomaddress="test@aspfreinds.com"
      CASE 7
         randomaddress="test@trusted.aspfreinds.com"

      CASE 8
         randomaddress="test@aspfreind.com"
      CASE 9
         randomaddress="test@trusted.aspfreind.com"
   END SELECT


   randomize
   bodyrandom="Orcsweb time:" & now() & " testing " & int(rnd*10000)+1 & " with this random message"

   Mailer.FromName = "Charles Carroll"
   Mailer.FromAddress = fromrandom
   Mailer.AddRecipient "test",randomaddress
   Mailer.AddRecipient "test","test-moderate-newmoderators@aspfriends.com"
   'Mailer.AddBCC "asplistsorcsweb", "asplists@orcsweb.com"
   'Mailer.AddBCC "test", "charlesmarkcarroll@yahoo.com"
   Mailer.Subject = "test"

   Mailer.BodyText = bodyrandom
   If Mailer.SendMail then
      LyrisTest="Successfull Lyris Test Mail to " & randomaddress & " from " & fromrandom & " !" & "<br>" & vbcrlf & bodyrandom
   Else
      LyrisTest="Failed Lyris Test Mail: <b>" & mailer.response & "</b>"
   End If
   set mailer=nothing

END FUNCTION

FUNCTION AccessHealth(parmfilename)
   on error resume next
   accessdb=parmfilename
   'sourceDSN="DRIVER={Microsoft Access Driver (*.mdb)};"
   'sourceDSN=sourceDSN & "DBQ=" & server.mappath(accessdb)

   sourceDSN="PROVIDER=Microsoft.Jet.OLEDB.4.0;"
   sourceDSN=sourceDSN & "DATA SOURCE="
   temploc=instr(accessdb,":")
   If temploc=0 THEN
      sourceDSN=sourceDSN & server.mappath(accessDB) & ";"
   ELSE
      sourceDSN=sourceDSN & accessDB & ";"
   END IF
   'sourceDSN=sourceDSN & "USER ID=;PASSWORD=;"

   ' Open Access Database
   set sourceconn=server.createobject("adodb.connection")
   sourceconn.open sourceDSN
   accesserror=""
   howmany=sourceconn.errors.count
'   response.write howmany & "<br>"
   IF howmany>0 THEN
      accesshealth="Access <font color='red'>not</font> OK"
      accesshealth=accesshealth & "<br>&nbsp;&nbsp;Conn: " & sourceDSN
      for counter=1 to howmany
         accesserror=accesserror & "<br>&nbsp;&nbsp;Detail #" & sourceconn.errors(counter).number
         accesserror=accesserror & "<br>&nbsp;&nbsp;Desc. " & sourceconn.errors(counter).description
      next
   ELSE
      accesshealth="Access OK"
      accesshealth=accesshealth & "<br>&nbsp;&nbsp;Conn: " & sourceDSN
   END IF
'   TempLoc=instr(accesshealth,"Access OK")
'   if TempLOC=0 THEN
'      accesshealth="Access OK: " & cluster & " Failed test"
'      accesshealth=accesshealth & "<br>ADO v" & sourceconn.version & "<br>"
'      accesshealth=accesshealth & "&nbsp;&nbsp;Conn: " & sourceDSN
'      accesshealth=accesshealth & accesserror
'   END IF
   sourceconn.close
   set sourceconn=nothing
END FUNCTION

FUNCTION DataUseful()
'changed by Brad of ORCSWeb because of continued
'false alerts from our monitoring tools. The table
'"publishers" does not exist in the learnasp database.

Exit function
   myDSN="DSN=Student;uid=student;pwd=magic"
   mySQL="select * from publishers where state='NY'"

   set conntemp=server.createobject("adodb.connection")
   conntemp.open myDSN
   set rstemp=conntemp.execute(mySQL)
   If rstemp.eof then
      DataUseful="<font color='red'><b>bad news</b> New York records don't exist</font><br>"
      Call RefreshPublishers
      ELSE
            DataUseful="<b>good news</b> New York Data OK"
   END IF

   rstemp.close
   set rstemp=nothing
      conntemp.close
      set conntemp=nothing
END FUNCTION

SUB RefreshPublishers()
   'ON ERROR RESUME NEXT
   accessdb="/learn/test/biblio.mdb"
   sourceSQL="select * from publishers"

   sourceDSN="PROVIDER=Microsoft.Jet.OLEDB.4.0;"
   sourceDSN=sourceDSN & "DATA SOURCE=" & server.mappath(accessDB) & ";"
   'sourceDSN=sourceDSN & "USER ID=;PASSWORD=;"

   targetDSN="DSN=Student;uid=student;pwd=magic"

   ' Open Access Database
   set sourceconn=server.createobject("adodb.connection")
   sourceconn.open sourceDSN
   set rstemp=sourceconn.execute(SourceSQL)

   set targetconn=server.createobject("adodb.connection")
   targetconn.open targetDSN
   targetconn.execute "DELETE from publishers"

DO  UNTIL Rstemp.eof
   transferSQL="INSERT INTO publishers"
   'transferSQL=transferSQL & " (pubid,[name],[company Name],Address,City,State,Zip,Telephone,Fax,Comments) "
   transferSQL=transferSQL & " VALUES ("
   transferSQL=transferSQL & rstemp(0) & ", "
   'transferSQL=transferSQL & ", "
   For counter=1 TO 8
         insertvalue=rstemp(counter)

         If trim(insertvalue)="" or isnull(insertvalue) THEN
            transferSQL=transferSQL & "NULL,"
         ELSE
            tempvalue=rstemp(counter)
            tempvalue=replace(tempvalue,"'","''")
            transferSQL=transferSQL & "'" & tempvalue & "',"
         END IF
   NEXT
   transferSQL=transferSQL & "'" & rstemp(9) & "')"
   response.write TransferSQL & "<br>"
   response.flush
   targetconn.execute(transferSQL)
   rstemp.movenext
LOOP
   rstemp.close
   set rstemp=nothing
      sourceconn.close
      set sourceconn=nothing

      targetconn.close
      set targetconn=nothing
END SUB

SUB ServerRestartDisplay
   IF application("serverstart")="" THEN
      application("serverstart")=now()
   END IF
   IF application("componentcheckcount")="" THEN
      application("componentcheckcount")=1
   ELSE
      application("componentcheckcount")=application("componentcheckcount")+1
   END IF
   serverstart=application("serverstart")
   response.write "<b>IIS</b> Re-started: <b>" & application("serverstart") & "</b><br>"
   response.write "&nbsp;&nbsp;&nbsp;This Script ran <b>" & application("componentcheckcount") & "</b> times since the server restarted.<br>"
   response.write "&nbsp;&nbsp;&nbsp;Server Up for <b>" & datediff("h",serverstart,now()) & "</b> hours without a restart.<br><hr><br>"
END SUB

FUNCTION whichserver
   whichfile=server.mappath("/orcsweb/server.txt")
   Set fs = CreateObject("Scripting.FileSystemObject")
   Set thisfile = fs.OpenTextFile(whichfile, 1, False)
   whichserver=thisfile.readall
   thisfile.Close
   set thisfile=nothing
   set fs=nothing
END FUNCTION
%>

Health Monitor for Server	Table of Contents PrintView
<Previous> Promos Ads	Cutting Edge Site. NOT!!!! <Next>

CL1 webserver: <Anantsystems>  <Ad info>       related sites: <FREE Help> <ASP> <Asp.net> <worldwide>   feedback: <lovethat> <hatethat> <thanks> <credits> <contact us>