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"/>
    </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)
    Dim ctrl, helloBody, path

    path = ctx.Path

    If applicationName = "production" And path = "/hello" Then
        Set ctrl = Nothing
        On Error Resume Next
        Set ctrl = CreateObject("WscMvc.HomeController")
        If Err.Number <> 0 Then
            Err.Clear
            On Error Goto 0
            statusLine = "500 Internal Server Error"
            contentType = "text/plain; charset=utf-8"
            body = "Internal Server Error"
            LogOutcome ctx, statusLine
            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
            statusLine = "500 Internal Server Error"
            contentType = "text/plain; charset=utf-8"
            body = "Internal Server Error"
            Set ctrl = Nothing
            LogOutcome ctx, statusLine
            Exit Sub
        End If
        On Error Goto 0

        statusLine = "200 OK"
        contentType = "text/html; charset=utf-8"
        body = helloBody
        Set ctrl = Nothing
    ElseIf applicationName = "tests" And path = "/self-test" Then
        Set ctrl = Nothing
        On Error Resume Next
        Set ctrl = CreateObject("WscMvc.SelfTestController")
        If Err.Number <> 0 Then
            Err.Clear
            On Error Goto 0
            statusLine = "500 Internal Server Error"
            contentType = "text/plain; charset=utf-8"
            body = "Internal Server Error"
            LogOutcome ctx, statusLine
            Exit Sub
        End If
        On Error Goto 0

        Dim selfTestBody
        selfTestBody = ""
        On Error Resume Next
        ctrl.RunSelfTest ctx.LogDir, selfTestBody
        If Err.Number <> 0 Then
            Err.Clear
            On Error Goto 0
            statusLine = "500 Internal Server Error"
            contentType = "text/plain; charset=utf-8"
            body = "Internal Server Error"
            Set ctrl = Nothing
            LogOutcome ctx, statusLine
            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
        Set ctrl = Nothing
    Else
        ' Expected outcome, not a failure: no matching route yet (M3 adds a real table).
        statusLine = "404 Not Found"
        contentType = "text/plain; charset=utf-8"
        body = "Not Found"
    End If

    LogOutcome ctx, statusLine
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>