<%@LANGUAGE="VBSCRIPT"%> <% '===================================================== ' Release Manager Admin Tests ' Designed to be called via AJAX and to return ' JSON formatted data to dynamic page '===================================================== %> <% Option explicit ' Good idea to set when using redirect Response.Expires = 0 ' always load the page, dont store Response.ContentType="application/json" %> <% '------------ Variable Definition ------------- Dim parOpr, newitem Dim result ' Basic Parameters parOpr = QStrPar("Opr") result = -1 ' Init the output JSON class ' Operations can add data ' Default data will be added at the end Dim oJSON Set oJSON = New aspJSON ' ' Determine the operation to be performed ' Invoke target routine ' Expect: ' result - test result ' oJSON.data("emsgSummary") - Error detail ' ' If (parOpr = "zipTest") Then Call zipFile ElseIf (parOpr = "eventTest") Then Call sendEvent ElseIf (parOpr = "emailTest") Then Call sendEmail ElseIf (parOpr = "reportEvent") Then Call reportEvent ElseIf (parOpr = "remExecTest") Then Call remExecTest ElseIf (parOpr = "pkgAccessTest") Then Call pkgAccessTest ElseIf (parOpr = "lxrAccessTest") Then Call lxrAccessTest ElseIf (parOpr = "abtLogAccess") Then Call abtLogAccess Else oJSON.data("emsgSummary") = "Unknown operation requested:" & parOpr End If ' ' Create JSON data for the user ' Important fields ' result ' ' Debug fields ' Request (Array) ' 'Write single value oJSON.data("result") = result ' DEBUG: An array of the user provided requests Set oJSON.data("Request") = oJSON.Collection() Set newitem = oJSON.AddToCollection(oJSON.data("Request")) Dim variableName for each variableName in Request.QueryString newitem.add variableName, Request.QueryString(variableName) next 'Return the object Response.Write oJSON.JSONoutput() Set oJSON = Nothing Call Destroy_All_Objects '------------------------------------------------- ' Function: zipFile ' Description: Test the File Zipping process Sub zipFile ' ' Create a test file in a known directory ' Dim objZIPObject, ZipFile Dim outFile, objFSO, LocalDir, objFile Set objFSO=CreateObject("Scripting.FileSystemObject") LocalDir = Server.MapPath("temp") If NOT objFSO.FolderExists( LocalDir ) Then result = 1 oJSON.data("emsgSummary") = "Folder not found:" & LocalDir Else ' Create a known file to zip up ' outFile = LocalDir & "zipTestFile.txt" Set objFile = objFSO.CreateTextFile(outFile,True) objFile.Write "test string" & vbCrLf objFile.Close ' Zip up a test file ' ZipFile = LocalDir & "zipTest.zip" If objFSO.FileExists(ZipFile) Then objFSO.DeleteFile ZipFile, TRUE End If On Error Resume Next Set objZIPObject = Server.CreateObject("XStandard.Zip") If Err.Number <> 0 then result = 1 oJSON.data("emsgSummary") = "Create XStandard.Zip:" & Err.Description Else objZIPObject.Pack outFile, ZipFile If objZIPObject.ErrorCode <> 0 then result = 1 oJSON.data("emsgSummary") = "Zip Error XStandard:" & objZIPObject.ErrorCode & ":" & objZIPObject.ErrorDescription Else ' All done - must have passed result = 0 End If End If ' ' Clean up If objFSO.FileExists(outFile) Then objFSO.DeleteFile outFile, TRUE End If If objFSO.FileExists(ZipFile) Then objFSO.DeleteFile ZipFile, TRUE End If objZIPObject = Nothing End If set objFSO = Nothing End Sub '------------------------------------------------- ' Function: reportEvent ' Description: Create an event in the machines event log Sub reportEvent Report_Event enumEVENT_ERROR, "Admin Test", "", "Release Manager test: reportEvent" If Err.number = 0 Then result = 0 Else result = 1 oJSON.data("emsgSummary") = "Error:("&Err.number&"):" & Err.description End If End Sub '------------------------------------------------- ' Function: sendEvent ' Description: Send an Event to the Windows Log Sub sendEvent Send_Event enumEVENT_ERROR, "Release Manager Test Log" If Err.number = 0 Then result = 0 Else result = 1 oJSON.data("emsgSummary") = "Error:("&Err.number&"):" & err.description End If End Sub '------------------------------------------------- ' Function: sendEmail ' Description: Send an email Sub sendEmail Dim Mode, Attachment, Message Attachment = Null Message = "This is a Test Email generated by the Release Manager Test." Mode = QStrPar("Mode") If Mode = "Attach" Then Attachment = Server.MapPath("images\img_reports_admin.jpg") Message = Message & " This message should have an attachment" End If Call Send_Email ( "Release Manager Notification", _ ADMIN_EMAIL, _ objAccessControl.UserEmail, _ "Test Email", _ Message, _ Attachment ) result = Err.Number oJSON.data("emsgSummary") = Err.Description 'oJSON.data("Info1") = Mode 'oJSON.data("Info2") = Attachment End Sub '------------------------------------------------- ' Function: remExecTest ' Description: Ensure that we can communicate with the package server Sub remExecTest Dim objRC: Set objRC = New ReleaseChanged Dim rv Call objRC.TestAccess(request.servervariables("server_name")) rv = objRc.last_resultCode If rv = 0 Then result = 0 Else result = 1 oJSON.data("emsgSummary") = "Error:("&rv&"), " & objRc.last_errorMsg End If Set objRC = Nothing End Sub '------------------------------------------------- ' Function: pkgAccessTest ' Description: Test dpkg_archive access - can we map it ' Sub pkgAccessTest If testArchiveAccessPkg("","") Then result = 0 Else result = 1 oJSON.data("emsgSummary") = "Archive not responding" End If End Sub '------------------------------------------------- ' Function: lxrAccessTest ' Description: Test dpkg_archive access - can we map it ' Sub lxrAccessTest Dim oXMLHTTP Dim testUrl Dim testAccess testAccess = False testUrl = LXR_URL & ".test" Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0") ' Use error handling in case dpkg_archive is not available ' Use HEAD to test existence Err.Clear On Error Resume Next oXMLHTTP.Open "HEAD", testUrl, False oXMLHTTP.Send ' Do not combine the next two If statments - it will not work If Err.Number = 0 Then If oXMLHTTP.Status = 200 Then testAccess = True End If End If On Error Goto 0 If testAccess Then result = 0 Else result = 1 oJSON.data("emsgSummary") = "LXR Server not responding" End If End Sub '------------------------------------------------- ' Function: abtLogAccess ' Description: Test dpkg_archive access - can we map it ' Sub abtLogAccess Dim oXMLHTTP Dim testUrl Dim testAccess testAccess = False testUrl = HTTP_PKG_ARCHIVE & "/cgi-bin/getBuildLogs.pl" Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0") ' Use error handling in case dpkg_archive is not available ' Use HEAD to test existence Err.Clear On Error Resume Next oXMLHTTP.Open "HEAD", testUrl, False oXMLHTTP.Send ' Do not combine the next two If statments - it will not work If Err.Number = 0 Then If oXMLHTTP.Status = 200 Then testAccess = True End If End If On Error Goto 0 If testAccess Then result = 0 Else result = 1 oJSON.data("emsgSummary") = "ABTLOG Server not responding" End If End Sub %>