Subversion Repositories DevTools

Rev

Rev 5357 | Rev 5957 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
4477 dpurdie 1
<%@LANGUAGE="VBSCRIPT"%>
2
<%
3
'=====================================================
4
'       Release Manager Admin Tests
5
'       Designed to be called via AJAX and to return
6
'       JSON formatted data to dynamic page
7
'=====================================================
8
%>
9
<%
10
Option explicit
11
' Good idea to set when using redirect
12
Response.Expires = 0   ' always load the page, dont store
5168 dpurdie 13
Response.ContentType="application/json"
4477 dpurdie 14
%>
15
<!--#include file="common/conf.asp"-->
16
<!--#include file="common/globals.asp"-->
17
<!--#include file="common/qstr.asp"-->
18
<!--#include file="common/common_subs.asp"-->
19
<!--#include file="common/formating.asp"-->
5097 dpurdie 20
<!--#include file="common/release_changed.asp"-->
4477 dpurdie 21
<SCRIPT LANGUAGE="VBScript" RUNAT=SERVER SRC="common/base64encode.vbs"></SCRIPT> 
22
<SCRIPT LANGUAGE="VBScript" RUNAT=SERVER SRC="class/classaspJSON.vbs"></SCRIPT> 
23
<%
24
'------------ Variable Definition -------------
25
Dim parOpr, newitem
26
Dim result
27
 
28
' Basic Parameters
29
parOpr = QStrPar("Opr")
30
result = -1
31
 
32
' Init the output JSON class
33
'   Operations can add data
34
'   Default data will be added at the end
35
Dim oJSON
36
Set oJSON = New aspJSON
37
 
38
'
39
'   Determine the operation to be performed
4482 dpurdie 40
'   Invoke target routine
41
'   Expect:
42
'       result                    - test result
43
'       oJSON.data("emsgSummary") - Error detail
4477 dpurdie 44
'
4482 dpurdie 45
'
4477 dpurdie 46
If (parOpr = "zipTest") Then
4482 dpurdie 47
    Call zipFile
48
ElseIf (parOpr = "eventTest") Then
49
    Call sendEvent
50
ElseIf (parOpr = "emailTest") Then
51
    Call sendEmail
5172 dpurdie 52
ElseIf (parOpr = "reportEvent") Then
53
    Call reportEvent
4482 dpurdie 54
ElseIf (parOpr = "remExecTest") Then
5172 dpurdie 55
    Call remExecTest
4482 dpurdie 56
ElseIf (parOpr = "pkgAccessTest") Then
5172 dpurdie 57
    Call pkgAccessTest
5245 dpurdie 58
ElseIf (parOpr = "lxrAccessTest") Then
59
    Call lxrAccessTest
5097 dpurdie 60
 
4482 dpurdie 61
Else
62
    oJSON.data("emsgSummary") = "Unknown operation requested:" & parOpr
63
End If
4477 dpurdie 64
 
4482 dpurdie 65
'
66
'   Create JSON data for the user
67
'   Important fields
68
'       result
69
'
70
'   Debug fields
71
'       Request (Array)
72
'
73
'Write single value
74
oJSON.data("result") = result
75
 
76
' DEBUG: An array of the user provided requests
77
Set oJSON.data("Request") = oJSON.Collection()
78
Set newitem = oJSON.AddToCollection(oJSON.data("Request"))
79
Dim variableName
80
for each variableName in Request.QueryString
81
    newitem.add variableName, Request.QueryString(variableName)
82
next
83
 
84
'Return the object
85
Response.Write oJSON.JSONoutput()
86
 
87
'-------------------------------------------------
88
' Function:    zipFile
89
' Description: Test the File Zipping process
90
Sub zipFile
4477 dpurdie 91
    '
92
    ' Create a test file in a known directory
93
    '
94
    Dim objZIPObject, ZipFile
95
    Dim outFile, objFSO, LocalDir, objFile
96
    Set objFSO=CreateObject("Scripting.FileSystemObject")
97
    LocalDir = Request.ServerVariables("APPL_PHYSICAL_PATH") & "release_manager\temp\"
98
 
99
    If NOT objFSO.FolderExists( LocalDir ) Then
100
        result = 1
101
        oJSON.data("emsgSummary") = "Folder not found:" & LocalDir
102
    Else
103
        ' Create a known file to zip up
104
        '
105
        outFile = LocalDir & "zipTestFile.txt"
106
        Set objFile = objFSO.CreateTextFile(outFile,True)
107
        objFile.Write "test string" & vbCrLf
108
        objFile.Close
109
 
110
        ' Zip up a test file
111
        '
112
        ZipFile = LocalDir & "zipTest.zip"
113
        If objFSO.FileExists(ZipFile) Then
114
       	    objFSO.DeleteFile ZipFile, TRUE
115
        End If
116
 
117
        On Error Resume Next
118
    	Set objZIPObject = Server.CreateObject("XStandard.Zip")
119
        If Err.Number <> 0 then
120
            result = 1
121
            oJSON.data("emsgSummary") = "Create XStandard.Zip:" & Err.Description
122
        Else
123
            objZIPObject.Pack outFile, ZipFile
124
 
125
            If objZIPObject.ErrorCode <> 0 then
126
                    result = 1
127
                    oJSON.data("emsgSummary") = "Zip Error XStandard:" & objZIPObject.ErrorCode & ":" & objZIPObject.ErrorDescription
128
            Else
129
                ' All done - must have passed
130
                result = 0
131
 
132
            End If
133
        End If
134
 
135
        '
136
        ' Clean up
137
        If objFSO.FileExists(outFile) Then
138
       	    objFSO.DeleteFile outFile, TRUE
139
        End If
140
 
141
        If objFSO.FileExists(ZipFile) Then
142
       	    objFSO.DeleteFile ZipFile, TRUE
143
        End If
144
 
145
        objZIPObject = Nothing
146
 
147
    End If
148
    set objFSO = Nothing
4482 dpurdie 149
End Sub
4477 dpurdie 150
 
4482 dpurdie 151
'-------------------------------------------------
5168 dpurdie 152
' Function:    reportEvent
153
' Description:  Create an event in the machines event log
154
 
155
Sub reportEvent
156
    Report_Event enumEVENT_ERROR, "Admin Test", "", "Release Manager test: reportEvent" 
157
    If Err.number = 0 Then
158
        result = 0
159
    Else
160
        result = 1
161
        oJSON.data("emsgSummary") = "Error:("&Err.number&"):" & Err.description
162
    End If
163
End Sub
164
 
165
'-------------------------------------------------
4482 dpurdie 166
' Function:    sendEvent
167
' Description: Send an Event to the Windows Log
168
Sub sendEvent
5168 dpurdie 169
    Send_Event enumEVENT_ERROR, "Release Manager Test Log" 
170
    If Err.number = 0 Then
171
        result = 0
172
    Else
173
        result = 1
174
        oJSON.data("emsgSummary") = "Error:("&Err.number&"):" & err.description
175
    End If
176
End Sub
177
 
178
'-------------------------------------------------
4482 dpurdie 179
' Function:     sendEmail
180
' Description:  Send an email
181
Sub sendEmail
182
   Dim Mode, Attachment, Message
183
 
184
   Attachment = Null
185
   Message = "This is a Test Email generated by the Release Manager Test."
186
   Mode = QStrPar("Mode")
187
 
188
   If Mode = "Attach" Then
189
        Attachment = Server.MapPath("images\img_reports_admin.jpg")
190
        Message = Message & " This message should have an attachment"
191
   End If
192
 
193
    Call Send_Email ( "Release Manager Notification", _
5357 dpurdie 194
                       ADMIN_EMAIL, _
4482 dpurdie 195
                       objAccessControl.UserEmail, _
196
                       "Test Email", _
197
                       Message, _
198
                       Attachment )
199
    result = Err.Number
200
    oJSON.data("emsgSummary") = Err.Description
201
    'oJSON.data("Info1") = Mode
202
    'oJSON.data("Info2") = Attachment
203
End Sub
204
 
205
'-------------------------------------------------
5172 dpurdie 206
' Function:    remExecTest
207
' Description: Ensure that we can communicate with the package server
208
 
209
Sub remExecTest
4482 dpurdie 210
 
5172 dpurdie 211
    Dim objRC: Set objRC = New ReleaseChanged
212
    Dim rv
4482 dpurdie 213
 
5172 dpurdie 214
    Call objRC.TestAccess(request.servervariables("server_name"))
215
    rv = objRc.last_resultCode
4482 dpurdie 216
    If rv = 0 Then
217
        result = 0
218
    Else
219
        result = 1
5172 dpurdie 220
        oJSON.data("emsgSummary") = "Error:("&rv&"), " & objRc.last_errorMsg
4482 dpurdie 221
    End If
5172 dpurdie 222
    Set objRC = Nothing
4482 dpurdie 223
End Sub
224
 
225
'-------------------------------------------------
5172 dpurdie 226
' Function:    pkgAccessTest
4482 dpurdie 227
' Description: Test dpkg_archive access - can we map it
4477 dpurdie 228
'
5172 dpurdie 229
Sub pkgAccessTest
4477 dpurdie 230
 
5172 dpurdie 231
    If testArchiveAccessPkg("","") Then
4482 dpurdie 232
        result = 0
233
    Else
234
        result = 1
5172 dpurdie 235
        oJSON.data("emsgSummary") = "Archive not responding"
4482 dpurdie 236
    End If
237
End Sub
4477 dpurdie 238
 
5245 dpurdie 239
'-------------------------------------------------
240
' Function:    lxrAccessTest
241
' Description: Test dpkg_archive access - can we map it
242
'
243
Sub lxrAccessTest
244
 
245
    Dim oXMLHTTP
246
    Dim testUrl
247
    Dim testAccess
248
    testAccess = False
249
    testUrl = LXR_URL
250
    Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0")
251
 
252
    ' Use error handling in case dpkg_archive is not available
253
    ' Use HEAD to test existence
254
    Err.Clear
255
    On Error Resume Next
256
    oXMLHTTP.Open "HEAD", testUrl, False
257
    oXMLHTTP.Send
258
 
259
    ' Do not combine the next two If statments - it will not work
260
    If Err.Number = 0  Then
261
    If oXMLHTTP.Status = 200 Then 
262
        testAccess = True
263
    End If
264
    End If
265
    On Error Goto 0
266
 
267
    If testAccess Then
268
        result = 0
269
    Else
270
        result = 1
271
        oJSON.data("emsgSummary") = "LXR Server not responding"
272
    End If
273
End Sub
274
 
4477 dpurdie 275
%>