Subversion Repositories DevTools

<%@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"
%>
<!--#include file="common/conf.asp"-->
<!--#include file="common/globals.asp"-->
<!--#include file="common/qstr.asp"-->
<!--#include file="common/common_subs.asp"-->
<!--#include file="common/formating.asp"-->
<!--#include file="common/release_changed.asp"-->
<SCRIPT LANGUAGE="VBScript" RUNAT=SERVER SRC="common/base64encode.vbs"></SCRIPT> 
<SCRIPT LANGUAGE="VBScript" RUNAT=SERVER SRC="class/classaspJSON.vbs"></SCRIPT> 
<%
'------------ 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

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 = Request.ServerVariables("APPL_PHYSICAL_PATH") & "release_manager\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

%>