Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

695 lines
17 KiB

<% '==================================================
' Module: inc_debug.asp
'
' Synopsis: Server Appliance Web Framework Error Handling
'
' Copyright (c) Microsoft Corporation. All rights reserved.
'==================================================
%>
<%
'Server.ScriptTimeout = 300
'
' Global variables for Error handling support
'
Const MAX_TRACEFILE_SIZE = 500000
Const MINIMUM_SCRIPT_TIMEOUT = 300
'
' ReEntrancy check variable
DIM SA_INSIDE_DEBUG
SA_INSIDE_DEBUG = 0
' Last error code.
' DO NOT access this variable directly, use SA_GetLastError
DIM SA_LASTERROR
' Function executing during last error
' DO NOT access this variable, it's for internal use only
DIM SA_LASTERROR_FUNCTION
' Tracing options
Const SA_TRACE_OUTPUT_NONE = 0
Const SA_TRACE_OUTPUT_HTML = 1
Const SA_TRACE_OUTPUT_FILE = 2
'
' Debugging enabled, default is enabled.
' DO NOT access this variable, it's for internal use only.
'
' This variable is set in LoadRuntimeOptions() which
' is called below. We default to enabled just in case
' LoadRuntimeOptions failes to initialize.
DIM SA_DEBUG_ENABLED
SA_DEBUG_ENABLED = 0
' Tracing option, default is HTML
' DO NOT access this variable, it's for internal use only.
'
' This variable is set in LoadRuntimeOptions() which
' is called below. We default to enabled just in case
' LoadRuntimeOptions failes to initialize.
DIM SA_TRACE_OPTION
SA_TRACE_OPTION = SA_TRACE_OUTPUT_NONE
' Current Tracing output file
' DO NOT access this variable, it's for internal use only
DIM SA_TRACE_FILE
'
' Global constant error codes
Const gc_ERR_SUCCESS = 0
SA_LASTERROR = gc_ERR_SUCCESS
'
' Set the Runtime options
'
LoadRuntimeOptions()
'
' Set page level error handling
'
If (SA_DEBUG_ENABLED <> 0) Then
'
' Debugging mode
'
On Error goto 0
Else
'
' Release mode
'
On Error Resume Next
End If
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Private Function LoadRuntimeOptions()
ON ERROR RESUME NEXT
Dim objRegistry
Dim dwDebugOption
'
' Prevent recursion into this module. Specifically, SA_TraceOut
SA_EnterDebugModule()
'
' Disable for now
'
Set objRegistry = RegConnection()
If (NOT IsObject(objRegistry)) Then
SA_TraceOut "LoadRuntimeOptions", "RegConnection() failed " + "(" + Hex(Err.Number) + ")"
Exit Function
End If
'
' Fetch debugging flag
'
SA_DEBUG_ENABLED= GetRegkeyValue( objRegistry, _
"SOFTWARE\Microsoft\ServerAppliance\WebFramework",_
"Debug", CONST_DWORD)
If (SA_DEBUG_ENABLED <> 0) Then
'
' Debugging mode
'
On Error goto 0
Else
'
' Release mode
'
On Error Resume Next
End If
SA_TRACE_OPTION = GetRegkeyValue( objRegistry, _
"SOFTWARE\Microsoft\ServerAppliance\WebFramework",_
"TraceOption", CONST_DWORD)
SA_TRACE_FILE = GetRegkeyValue( objRegistry, _
"SOFTWARE\Microsoft\ServerAppliance\WebFramework",_
"TraceFile", CONST_STRING)
Dim iScriptTimeOut
iScriptTimeOut = GetRegkeyValue( objRegistry, _
"SOFTWARE\Microsoft\ServerAppliance\WebFramework",_
"ScriptTimeOut", CONST_DWORD)
If ( NOT IsNumeric(iScriptTimeOut) ) Then
iScriptTimeOut = MINIMUM_SCRIPT_TIMEOUT
ElseIf ( iScriptTimeOut < MINIMUM_SCRIPT_TIMEOUT ) Then
iScriptTimeOut = MINIMUM_SCRIPT_TIMEOUT
End If
Server.ScriptTimeout = CInt(iScriptTimeOut)
SA_ExitDebugModule()
Set objRegistry = nothing
End Function
' --------------------------------------------------------------
'
' Function: SA_EnterDebugModule
'
' Synopsis: Mark us as inside the debug module. This is used for
' reentrancy checks. We don't want to get caught in
' a recussion loop if we have an error inside this module.
'
' Arguments:
'
' --------------------------------------------------------------
Private Function SA_EnterDebugModule()
SA_INSIDE_DEBUG = 1
End Function
' --------------------------------------------------------------
'
' Function: SA_ExitDebugModule
'
' Synopsis: Mark us as exiting the debug module. This is used for
' reentrancy checks. We don't want to get caught in
' a recussion loop if we have an error inside this module.
'
' Arguments:
'
' --------------------------------------------------------------
Private Function SA_ExitDebugModule()
SA_INSIDE_DEBUG = 0
End Function
' --------------------------------------------------------------
'
' Function: SA_IsExecutingDebugModule
'
' Synopsis: Check to see if we are reentering this module
'
' --------------------------------------------------------------
Private Function SA_IsExecutingDebugModule()
SA_IsExecutingDebugModule = SA_INSIDE_DEBUG
End Function
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Public Function SA_IsDebugEnabled()
SA_IsDebugEnabled = SA_DEBUG_ENABLED
End Function
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Public Function SA_EnableDebug(ByVal DebugEnabled)
SA_DEBUG_ENABLED = DebugEnabled
Dim objRegistry
Dim rc
Set objRegistry = RegConnection()
If (NOT IsObject(objRegistry)) Then
SA_TraceOut "SA_EnableDebug", "RegConnection() failed " + "(" + Hex(Err.Number) + ")"
Exit Function
End If
rc = UpdateRegkeyValue( objRegistry, _
"SOFTWARE\Microsoft\ServerAppliance\WebFramework",_
"Debug", _
DebugEnabled, _
CONST_DWORD)
Set objRegistry = nothing
SA_EnableDebug = gc_ERR_SUCCESS
End Function
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Public Function SA_GetTraceOption()
SA_GetTraceOption = SA_TRACE_OPTION
End Function
' --------------------------------------------------------------
'
' Function: SA_SetDebugOption
'
' Synopsis: Set the debugging option.
'
' Arguments: [in] Option - Debugging option to use which can be a combination of
' SA_TRACE_OUTPUT_HTML Debugging errors emitted with HTML response
' SA_TRACE_OUTPUT_FILE Debugging errors emitted to output file
'
' --------------------------------------------------------------
Public Function SA_SetDebugOption(ByVal DebugOption)
SA_TRACE_OPTION = DebugOption
Dim objRegistry
Dim rc
Set objRegistry = RegConnection()
If (NOT IsObject(objRegistry)) Then
SA_TraceOut "SA_SetDebugOption", "RegConnection() failed " + "(" + Hex(Err.Number) + ")"
Exit Function
End If
rc = UpdateRegkeyValue( objRegistry, _
"SOFTWARE\Microsoft\ServerAppliance\WebFramework",_
"TraceOption", _
DebugOption, _
CONST_DWORD)
Set objRegistry = nothing
SA_SetDebugOption = gc_ERR_SUCCESS
End Function
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Public Function SA_GetTraceOutputFile()
SA_GetTraceOutputFile = SA_TRACE_FILE
End Function
' --------------------------------------------------------------
'
' Function: SA_SetDebugOutputFile
'
' Synopsis: Set the debugging output file
'
' Arguments: [in] File - Filename to receive debugging output
'
' --------------------------------------------------------------
Public Function SA_SetDebugOutputFile(ByVal File)
SA_TRACE_FILE = File
Dim objRegistry
Dim rc
Set objRegistry = RegConnection()
If (NOT IsObject(objRegistry)) Then
SA_TraceOut "SA_SetDebugOutputFile", "RegConnection() failed " + "(" + Hex(Err.Number) + ")"
Exit Function
End If
rc = UpdateRegkeyValue( objRegistry, _
"SOFTWARE\Microsoft\ServerAppliance\WebFramework",_
"TraceFile", _
File, _
CONST_STRING)
Set objRegistry = nothing
SA_SetDebugOutputFile = gc_ERR_SUCCESS
End Function
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Function SA_ClearTraceLog()
#ifdef DBG
Dim fso
Dim traceFile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
If ( NOT IsObject(fso)) Then
SA_TraceOut "SA_ClearTraceLog", "CreateObject(Scripting.FileSystemObject) failed " + "(" + Hex(Err.Number) + ")"
Exit Function
End If
on error resume next
Set traceFile = fso.OpenTextFile(SA_TRACE_FILE, ForWriting, True)
If (NOT IsObject(traceFile)) Then
SA_TraceOut "LoadRuntimeOptions", _
"fso.OpenTextFile(SA_TRACE_FILE, ForWriting, True) failed " + "(" + Hex(Err.Number) + ")"
If SA_IsDebugEnabled() Then
on error goto 0
End If
Exit Function
End If
traceFile.Close
If SA_IsDebugEnabled() Then
on error goto 0
End If
Set traceFile = nothing
Set fso = nothing
#endif
End Function
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Function SA_ShowTraceLog()
#ifdef DBG
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso
Dim traceFile
Dim str
on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
If ( NOT IsObject(fso)) Then
SA_TraceOut "SA_ShowTraceLog", "CreateObject(Scripting.FileSystemObject) failed " + "(" + Hex(Err.Number) + ")"
If SA_IsDebugEnabled() Then
on error goto 0
End If
Exit Function
End If
Set traceFile = fso.OpenTextFile(SA_TRACE_FILE, ForReading, True)
If (NOT IsObject(traceFile)) Then
SA_TraceOut "SA_ShowTraceLog", _
"fso.OpenTextFile(SA_TRACE_FILE, ForWriting, True) failed " + "(" + Hex(Err.Number) + ")"
If SA_IsDebugEnabled() Then
on error goto 0
End If
fso = Nothing
Exit Function
End If
Response.Write("<H2>Trace Log</H2>")
Response.Write("<table>")
While NOT traceFile.AtEndOfStream
str = traceFile.ReadLine()
Response.Write("<tr><td>"+str+"</td></tr>")
Response.Flush
WEnd
Response.Write("</table>")
traceFile.Close
If SA_IsDebugEnabled() Then
on error goto 0
End If
Set traceFile = nothing
Set fso = nothing
#endif
End Function
' --------------------------------------------------------------
'
' Function:
'
' Synopsis:
'
' Arguments:
'
' --------------------------------------------------------------
Function SA_ShowRuntimeOptions()
#ifdef DBG
SA_TraceOut "CheckRuntimeOptions", "Begin"
Response.Write("<H2>Runtime Options</H2>")
Response.Write("<table title='SA Web Framework Options' cols=3 border=2 cellspace=2>"+vbCrLf)
Response.Write("<tr>")
Response.Write("<th align='left'>Setting</th>")
Response.Write("<th align='center'>Value</th>")
Response.Write("</tr>"+vbCrLf)
Response.Write("<tr>")
Response.Write("<td>Debug enabled</td>")
Response.Write("<td>" + CStr(SA_IsDebugEnabled()) + "</td>")
Response.Write("</tr>"+vbCrLf)
Response.Write("<tr>")
Response.Write("<td>Trace option</td>")
Response.Write("<td>" + CStr(SA_GetTraceOption()) + "</td>")
Response.Write("</tr>"+vbCrLf)
Response.Write("<tr>")
Response.Write("<td>Trace output</td>")
Response.Write("<td>" + Trim(SA_GetTraceOutputFile()) + "</td>")
Response.Write("</tr>"+vbCrLf)
Response.Write("</table>"+vbCrLf)
SA_TraceOut "CheckRuntimeOptions", "End"
#endif
End Function
' --------------------------------------------------------------
'
' Function: SA_TraceOut
'
' Synopsis: Output tracing information
'
' Arguments: [in] Module - Module/Function issuing the tracing message
' [in] Message - Message to be output
'
' --------------------------------------------------------------
Public Function SA_TraceOut(ByVal Module, ByVal Message)
#ifdef DBG
If (NOT SA_IsExecutingDebugModule() ) Then
SA_EnterDebugModule()
SA_InternalTraceOut Module, Message
SA_ExitDebugModule()
End If
#endif
SA_TraceOut = gc_ERR_SUCCESS
End Function
' --------------------------------------------------------------
'
' Function: SA_TraceErrorOut
'
' Synopsis: Output tracing information for error conditions. Errors are
' flaged with the keyword ISSUE.
'
' Arguments: [in] Module - Module/Function issuing the tracing message
' [in] Message - Message to be output
'
' --------------------------------------------------------------
Public Function SA_TraceErrorOut(ByVal Module, ByVal Message)
Dim rc
rc = SA_TraceOut("ISSUE: " + Module, Message)
SA_TraceErrorOut = rc
End Function
' --------------------------------------------------------------
'
' Function: SA_SetLastError
'
' Synopsis: Set the last error code.
'
' Arguments: [in] ErrorCode - Error code
' [in] FunctionName - Name of function where error occured
'
' --------------------------------------------------------------
Public Function SA_GetLastError()
SA_GetLastError = SA_LASTERROR
End Function
' --------------------------------------------------------------
'
' Function: SA_SetLastError
'
' Synopsis: Set the last error code.
'
' Arguments: [in] ErrorCode - Error code
' [in] FunctionName - Name of function where error occured
'
' Returns: The error code specified in ErrorCode parameter
'
' --------------------------------------------------------------
Public Function SA_SetLastError(ByVal ErrorCode, ByVal FunctionName )
SA_LASTERROR = ErrorCode
SA_LASTERROR_FUNCTION = FunctionName
Err.Number = ErrorCode
SA_SetLastError = ErrorCode
'
' If we had an error then emit trace output. An error is
' any error code other than gc_ERR_SUCCESS.
'
If ( ErrorCode <> gc_ERR_SUCCESS ) Then
SA_InternalTraceOut "ISSUE: "+FunctionName, CStr(ErrorCode)
End If
End Function
' --------------------------------------------------------------
'
' Function: SA_SetLastError
'
' Synopsis: Set the last error code.
'
' Arguments: [in] ErrorCode - Error code
' [in] FunctionName - Name of function where error occured
'
' --------------------------------------------------------------
Public Function SA_ClearError()
SA_LASTERROR = gc_ERR_SUCCESS
Err.Number = 0
SA_ClearError = gc_ERR_SUCCESS
End Function
' --------------------------------------------------------------
'
' Function: _SA_InternalTraceOut
'
' Synopsis: Internal function to handle output tracing.
'
' Arguments: [in] Module - Module/Function issuing the tracing message
' [in] Message - Message to be output
'
' --------------------------------------------------------------
Private Function SA_InternalTraceOut(ByVal Module, ByVal Message)
#ifdef DBG
on error resume next
'
' Trace errors to HTML response buffer
'
If (SA_TRACE_OPTION AND SA_TRACE_OUTPUT_HTML) Then
Response.Write("<SPAN style='color:white; background:red;'>")
Response.Write("<BR>")
Response.Write("<p>" + Module + " : " + Message)
Response.Write("<BR>")
Response.Write("</SPAN>")
End If
'
' Trace to file
'
If (SA_TRACE_OPTION AND SA_TRACE_OUTPUT_FILE) Then
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso
Dim traceFile
Set fso = CreateObject("Scripting.FileSystemObject")
If ( NOT IsObject(fso)) Then
'
' Can not call SA_TraceOut here since we are in it.
'
If SA_IsDebugEnabled() Then
on error goto 0
Else
on error resume next
End If
Exit Function
End If
Dim enOpenOption
enOpenOption = ForAppending
Err.Clear
Set traceFile = fso.GetFile(SA_TRACE_FILE)
If ( Err.Number = 0 ) Then
If ( traceFile.size > MAX_TRACEFILE_SIZE ) Then
enOpenOption = ForWriting
End If
End If
Set traceFile = nothing
Set traceFile = fso.OpenTextFile(SA_TRACE_FILE, enOpenOption, True)
If (NOT IsObject(traceFile)) Then
'
' Can not call SA_TraceOut here since we are in it.
'
Set fso = nothing
If SA_IsDebugEnabled() Then
on error goto 0
Else
on error resume next
End If
Exit Function
End If
traceFile.WriteLine CStr(Now())+": " + Module + " : " + Message
traceFile.Close
Set traceFile = Nothing
Set fso = Nothing
End If
If SA_IsDebugEnabled() Then
on error goto 0
Else
on error resume next
End If
#endif
SA_InternalTraceOut = gc_ERR_SUCCESS
End Function
%>