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

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

%>