wsc-mvc/Framework/Application.wsc

<?xml version="1.0"?>
<?component error="true" debug="false"?>
<component>
<registration
    description="WscMvc Application bootstrap"
    progid="WscMvc.Application"
    version="1.00"
    classid="{851C7763-1638-42FE-A166-BF3DD3A96A88}">
</registration>

<public>
    <method name="Run">
        <parameter name="ctx"/>
        <parameter name="applicationName"/>
        <parameter name="statusLine"/>
        <parameter name="contentType"/>
        <parameter name="body"/>
        <parameter name="allowHeader"/>
    </method>
</public>

<script language="VBScript">
<![CDATA[
Option Explicit

' Central request boundary: one place decides expected (404) vs unexpected
' (COM/method failure -> 500) outcomes, and one place logs them. ctx is our
' own WscMvc.RequestContext object (not an ASP intrinsic), carrying only
' primitive request data. No ASP intrinsics are referenced here.
Sub Run(ctx, applicationName, statusLine, contentType, body, allowHeader)
    Dim router, handlerKey

    statusLine = ""
    contentType = ""
    body = ""
    allowHeader = ""
    handlerKey = ""

    Set router = Nothing
    On Error Resume Next
    Set router = CreateObject("WscMvc.Router")
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        InternalServerError statusLine, contentType, body, allowHeader
        LogOutcome ctx, statusLine
        Exit Sub
    End If
    On Error Goto 0

    On Error Resume Next
    router.Match ctx, applicationName, statusLine, contentType, body, allowHeader, handlerKey
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set router = Nothing
        InternalServerError statusLine, contentType, body, allowHeader
        LogOutcome ctx, statusLine
        Exit Sub
    End If
    On Error Goto 0

    Set router = Nothing

    If Len(handlerKey) = 0 Then
        LogOutcome ctx, statusLine
        Exit Sub
    End If

    Select Case handlerKey
        Case "Home.Hello"
            RunHomeHello ctx, statusLine, contentType, body, allowHeader
        Case "SelfTest.RunSelfTest"
            RunSelfTest ctx, statusLine, contentType, body, allowHeader
        Case Else
            InternalServerError statusLine, contentType, body, allowHeader
    End Select

    LogOutcome ctx, statusLine
End Sub

Sub RunHomeHello(ctx, statusLine, contentType, body, allowHeader)
    Dim ctrl, helloBody

    Set ctrl = Nothing
    On Error Resume Next
    Set ctrl = CreateObject("WscMvc.HomeController")
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        InternalServerError statusLine, contentType, body, allowHeader
        Exit Sub
    End If
    On Error Goto 0

    helloBody = ""
    On Error Resume Next
    ctrl.Hello helloBody
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set ctrl = Nothing
        InternalServerError statusLine, contentType, body, allowHeader
        Exit Sub
    End If
    On Error Goto 0

    statusLine = "200 OK"
    contentType = "text/html; charset=utf-8"
    body = helloBody
    allowHeader = ""
    Set ctrl = Nothing
End Sub

Sub RunSelfTest(ctx, statusLine, contentType, body, allowHeader)
    Dim ctrl, selfTestBody

    Set ctrl = Nothing
    On Error Resume Next
    Set ctrl = CreateObject("WscMvc.SelfTestController")
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        InternalServerError statusLine, contentType, body, allowHeader
        Exit Sub
    End If
    On Error Goto 0

    selfTestBody = ""
    On Error Resume Next
    ctrl.RunSelfTest ctx.LogDir, selfTestBody
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set ctrl = Nothing
        InternalServerError statusLine, contentType, body, allowHeader
        Exit Sub
    End If
    On Error Goto 0

    ' Always 200: the self-test HTTP call itself succeeded. Whether the
    ' underlying checks passed is reported in the JSON body's "ok" field
    ' and per-check "pass" fields, not the HTTP status - this matches
    ' conventional health-check endpoint design (5xx is reserved for the
    ' diagnostics mechanism itself being broken, handled above).
    statusLine = "200 OK"
    contentType = "application/json; charset=utf-8"
    body = selfTestBody
    allowHeader = ""
    Set ctrl = Nothing
End Sub

Sub InternalServerError(statusLine, contentType, body, allowHeader)
    statusLine = "500 Internal Server Error"
    contentType = "text/plain; charset=utf-8"
    body = "Internal Server Error"
    allowHeader = ""
End Sub

' Best-effort diagnostics only: a logging failure must never affect the
' response. Every filesystem step is individually guarded so one bad
' operation (e.g. concurrent-write contention) just skips this line rather
' than raising to the caller.
Sub LogOutcome(ctx, statusLine)
    Dim fso, logFile, logPath, lockPath, line

    Set fso = Nothing
    On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Exit Sub
    End If
    On Error Goto 0

    On Error Resume Next
    If Not fso.FolderExists(ctx.LogDir) Then
        fso.CreateFolder ctx.LogDir
    End If
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        Set fso = Nothing
        Exit Sub
    End If
    On Error Goto 0

    logPath = ctx.LogDir & "\app.log"
    lockPath = ctx.LogDir & "\app.log.lock"

    ' Concurrent requests race for this one shared file. Verified experimentally
    ' that FileSystemObject.OpenTextFile(ForAppending) mostly SUCCEEDS for every
    ' concurrent caller (it is not exclusive) but their writes overwrite each
    ' other - a lost-update race, not an open failure - so retrying the open
    ' alone did not help. No ASP intrinsic (Application.Lock/UnLock) is available
    ' here by contract, so a manual lock-file mutex is used instead:
    ' CreateTextFile(path, OverwriteExisting:=False) atomically fails with
    ' Err.Number=58 "File already exists" when another request holds the lock -
    ' confirmed correct/exclusive experimentally, not assumed.
    '
    ' The retry budget below is deliberately short. Measured under 8 genuinely
    ' concurrent requests: the mutex itself is correct, but making every request
    ' reliably win eventually needs a retry budget of 300+ attempts (~300-360ms
    ' of blocking) - too much added latency for a best-effort diagnostic write.
    ' With this short budget, heavy concurrent bursts will legitimately drop
    ' some log lines rather than delay the response; this is an accepted
    ' tradeoff for "best-effort diagnostics" (see docs/DECISIONS.md), not a
    ' correctness bug - the HTTP response itself is unaffected either way.
    ' Revisit with a real logging mechanism (e.g. per-request files aggregated
    ' out of band) in M6 if complete log coverage under load becomes a
    ' requirement.
    If Not AcquireLogLock(fso, lockPath) Then
        Set fso = Nothing
        Exit Sub
    End If

    Set logFile = Nothing
    On Error Resume Next
    Set logFile = fso.OpenTextFile(logPath, 8, True) ' 8 = ForAppending, create if missing
    If Err.Number <> 0 Then
        Err.Clear
        On Error Goto 0
        ReleaseLogLock fso, lockPath
        Set fso = Nothing
        Exit Sub
    End If
    On Error Goto 0

    line = Now & " | " & ctx.CorrelationId & " | " & ctx.HttpMethod & _
        " | " & ctx.Path & " | " & statusLine & " | " & ctx.ElapsedMs() & "ms"

    On Error Resume Next
    logFile.WriteLine line
    Err.Clear
    On Error Goto 0

    On Error Resume Next
    logFile.Close
    Err.Clear
    On Error Goto 0

    Set logFile = Nothing
    ReleaseLogLock fso, lockPath
    Set fso = Nothing
End Sub

Function AcquireLogLock(fso, lockPath)
    Dim attempt, maxAttempts, lockFile, busy, spinCount
    maxAttempts = 10
    spinCount = 8000
    AcquireLogLock = False

    For attempt = 1 To maxAttempts
        Set lockFile = Nothing
        On Error Resume Next
        Set lockFile = fso.CreateTextFile(lockPath, False) ' fails if lockPath already exists
        If Err.Number = 0 Then
            On Error Goto 0
            lockFile.Close
            Set lockFile = Nothing
            AcquireLogLock = True
            Exit For
        End If
        Err.Clear
        On Error Goto 0
        For busy = 1 To spinCount : Next
    Next
End Function

Sub ReleaseLogLock(fso, lockPath)
    On Error Resume Next
    fso.DeleteFile lockPath, True
    Err.Clear
    On Error Goto 0
End Sub
]]>
</script>
</component>