asp-classic-unified-framework/core/mvc.wsc

<?xml version="1.0"?>
<!--  MVCDispatcher.wsc  -->
<component>

  <!-- COM registration -->
  <registration
      description = "Classic ASP MVC Dispatcher Component"
      progid      = "App.MVCDispatcher"
      version     = "1.0"
      classid     = "{C3D4E5F6-7A8B-49C0-8D1E-2F3A4B5C6D7E}" />

  <!-- Public interface -->
  <public>

    <property name="Router">
      <put internalName="PutRouter"/>
    </property>
    <property name="ControllerRegistry">
      <put internalName="PutControllerRegistry"/>
    </property>
    <property name="ControllerFactory">
      <put internalName="PutControllerFactory"/>
    </property>
    <property name="Routes">
      <put internalName="PutRoutes"/>
    </property>

    <property name="ControllerName">
      <get internalName="GetControllerName"/>
    </property>
    <property name="CurrentController">
      <get internalName="GetCurrentController"/>
    </property>
    <property name="UseLayout">
      <get internalName="GetUseLayout"/>
    </property>
    <property name="LastError">
      <get internalName="GetLastError"/>
    </property>

    <method name="Resolve"/>
    <method name="ExecuteAction"/>
    <method name="DispatchRequest"/>
    <method name="RequirePost"/>
    <method name="RedirectToAction"/>
    <method name="RedirectTo"/>
    <method name="RedirectToExt"/>
    <method name="RedirectToActionExt"/>

  </public>

  <!-- Give the component ASP intrinsic objects (Request, Response, Server ...) -->
  <implements type="ASP"/>

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

'------------------------------------------------------------
' Injected dependencies
'
' A WSC runs in its own isolated script engine, so it cannot see the
' including ASP page's globals (GetAppSetting, ControllerRegistry(),
' Routes(), router, the per-controller singleton functions, etc.) the
' way mvc.asp used to. Per AGENTS.md section 69/70 ("Dependencies Must
' Be Injected", "Avoid Hidden Dependencies"), everything this component
' needs from the outside is passed in explicitly instead.
'
' Properties here are wired to plain functions (PutX/GetX) via
' internalName in the <public> section above, rather than VBScript
' "Property Get/Let/Set" syntax - that syntax is only legal inside an
' explicit Class...End Class block (a general VBScript rule, not
' specific to WSC), and this component's members are declared directly
' in the script rather than inside a Class, matching router.wsc's
' existing convention in this project.
'------------------------------------------------------------
Private m_router
Private m_controllerRegistry
Private m_controllerFactory
Private m_routes

Private m_currentController
Private m_controllerName   ' "Controller" suffix stripped, e.g. "Home"
Private m_actionName
Private m_params
Private m_lastError

Sub PutRouter(value)
    Set m_router = value
End Sub

Sub PutControllerRegistry(value)
    Set m_controllerRegistry = value
End Sub

Sub PutControllerFactory(value)
    Set m_controllerFactory = value
End Sub

Sub PutRoutes(value)
    Set m_routes = value
End Sub

'------------------------------------------------------------
' Read-only state exposed to callers/views
'------------------------------------------------------------

' Name of the controller most recently resolved by Resolve(), with the
' "Controller" suffix stripped (e.g. "Home", not "HomeController").
Function GetControllerName()
    GetControllerName = m_controllerName
End Function

' The controller object itself, e.g. so a layout can read CurrentController.Title.
Function GetCurrentController()
    Set GetCurrentController = m_currentController
End Function

Function GetUseLayout()
    If IsObject(m_currentController) Then
        GetUseLayout = m_currentController.useLayout
    Else
        GetUseLayout = False
    End If
End Function

' Nothing when the last Resolve()/ExecuteAction() succeeded. Otherwise a
' Dictionary with "Type" ("Security" or "Action") plus either "Message"
' (Security) or "ActionName"/"Number"/"Description" (Action). Rendering
' this is the caller's job - per AGENTS.md's "Controllers Coordinate;
' They Do Not Render", this component never calls Response.Write.
Function GetLastError()
    Set GetLastError = m_lastError
End Function

'------------------------------------------------------------
' Resolve(method, path) -> Boolean
'
' Resolves the route, validates the controller/action name format and
' whitelist, and creates the controller via the injected ControllerFactory.
' Returns False and sets LastError (Type = "Security") if any check fails.
' Must be called before ExecuteAction().
'------------------------------------------------------------
Public Function Resolve(method, path)
    Dim routeArray, controllerNameRaw, actionNameRaw

    Set m_lastError = Nothing
    Set m_currentController = Nothing
    m_controllerName = ""
    m_actionName = ""
    m_params = Empty

    routeArray = m_router.Resolve(method, path)
    controllerNameRaw = routeArray(0)
    actionNameRaw = routeArray(1)

    If Not m_controllerRegistry.IsValidControllerFormat(controllerNameRaw) Then
        SetSecurityError "Invalid controller name format."
        Resolve = False
        Exit Function
    End If

    If Not m_controllerRegistry.IsValidActionFormat(actionNameRaw) Then
        SetSecurityError "Invalid action name format."
        Resolve = False
        Exit Function
    End If

    If Not m_controllerRegistry.IsValidController(controllerNameRaw) Then
        SetSecurityError "Controller '" & controllerNameRaw & "' is not registered."
        Resolve = False
        Exit Function
    End If

    Set m_currentController = m_controllerFactory.Create(controllerNameRaw)
    m_controllerName = StripControllerSuffix(controllerNameRaw)
    m_actionName = actionNameRaw

    If UBound(routeArray) >= 2 Then
        m_params = SurroundParamsInArray(routeArray(2))
    End If

    Resolve = True
End Function

'------------------------------------------------------------
' ExecuteAction()
'
' Invokes the resolved action on the resolved controller. Must follow a
' successful Resolve(). Populates LastError (Type = "Action") on failure
' instead of raising or writing HTML, so the caller decides how to show it.
'
' Named ExecuteAction rather than Execute because VBScript's Execute
' STATEMENT (used below to invoke the action by name) is shadowed by any
' Sub/Function of the same name in scope - a Sub literally named "Execute"
' cannot call the Execute statement from inside itself.
'
' The action name is still dispatched via a scoped Execute, since
' controllers do not (yet) implement the Invoke() reflection convention
' from AGENTS.md section 69 - that is a larger, separate change to every
' controller's contract. What this fixes is the CONTROLLER resolution:
' the original mvc.asp built "Set CurrentController = " & controllerName
' & "()" from a route-supplied string and Executed it, resolving an
' arbitrary global name at dispatch time. Here the controller always comes
' from the injected ControllerFactory (whitelisted, explicitly registered
' ahead of time), and this Execute only ever calls a method by name on
' that already-known object.
'------------------------------------------------------------
Public Sub ExecuteAction()
    Dim callString, errInfo

    If Not IsObject(m_currentController) Then
        Err.Raise vbObjectError + 1200, "MVCDispatcher.ExecuteAction", "ExecuteAction called before a successful Resolve."
    End If

    If IsArray(m_params) Then
        If UBound(m_params) >= 0 Then
            callString = "Call m_currentController." & m_actionName & "(" & Join(m_params, ",") & ")"
        Else
            callString = "Call m_currentController." & m_actionName & "()"
        End If
    Else
        callString = "Call m_currentController." & m_actionName & "()"
    End If

    On Error Resume Next
    Execute callString

    If Err.Number <> 0 Then
        Set errInfo = Server.CreateObject("Scripting.Dictionary")
        errInfo.Add "Type", "Action"
        errInfo.Add "ActionName", m_actionName
        errInfo.Add "Number", Err.Number
        errInfo.Add "Description", Err.Description
        Set m_lastError = errInfo
        Err.Clear
    End If
    On Error Goto 0
End Sub

'------------------------------------------------------------
' DispatchRequest(method, path)
'
' Convenience wrapper for callers that do not need layout wrapping or
' custom error rendering (e.g. tests): Resolve then ExecuteAction, silently
' doing nothing further on a Resolve failure. Callers that need to wrap
' output in a layout or render errors (the real app's entry point) should
' call Resolve/UseLayout/ExecuteAction/LastError directly instead - see
' public/Default.asp.
'------------------------------------------------------------
Public Sub DispatchRequest(method, path)
    If Resolve(method, path) Then
        ExecuteAction()
    End If
End Sub

'------------------------------------------------------------
Public Sub RequirePost()
    If Request.Form.Count = 0 Then
        RedirectToExt "NotValid", "", Empty
    End If
End Sub

' Shortcut for RedirectToActionExt that does not require passing a parameters argument.
Public Sub RedirectToAction(action_name)
    RedirectToActionExt action_name, Empty
End Sub

Public Sub RedirectTo(controller_name, action_name)
    RedirectToExt controller_name, action_name, Empty
End Sub

' Redirects the browser to the specified action on the specified controller with the
' specified querystring parameters. params is a KVArray of querystring parameters.
Public Sub RedirectToExt(controller_name, action_name, params)
    Response.Redirect m_routes.UrlTo(controller_name, action_name, params)
End Sub

Public Sub RedirectToActionExt(action_name, params)
    RedirectToExt m_controllerName, action_name, params
End Sub

'------------------------------------------------------------
' Private helpers
'------------------------------------------------------------
Private Sub SetSecurityError(message)
    Dim errInfo
    Set errInfo = Server.CreateObject("Scripting.Dictionary")
    errInfo.Add "Type", "Security"
    errInfo.Add "Message", message
    Set m_lastError = errInfo
End Sub

Private Function StripControllerSuffix(name)
    Const suffix = "Controller"
    If Len(name) > Len(suffix) And LCase(Right(name, Len(suffix))) = LCase(suffix) Then
        StripControllerSuffix = Left(name, Len(name) - Len(suffix))
    Else
        StripControllerSuffix = name
    End If
End Function

' Wraps string route params in quotes so they can be spliced into the
' dynamically-built Execute call string in ExecuteAction() above. Equivalent
' to the app-side SurroundStringInArray() helper, duplicated here (rather
' than called) because this WSC cannot see that global function.
Private Function SurroundParamsInArray(arr)
    Dim i, result
    result = arr
    For i = LBound(result) To UBound(result)
        If TypeName(result(i)) = "String" Then
            result(i) = """" & result(i) & """"
        End If
    Next
    SurroundParamsInArray = result
End Function
  ]]>
  </script>
</component>