<%
'==============================================================================
' Keycloak OpenID Connect helper
'==============================================================================
' Typical flow:
'   1. Configure KeycloakBaseUrl/Realm/ClientId/ClientSecret/RedirectUri in
'      public/web.config, or set those properties on KeycloakAuth().
'   2. Send users to KeycloakLogin().
'   3. Point the Keycloak redirect URI at an action that calls
'      KeycloakHandleCallback().
'   4. Use KeycloakCurrentUser(), KeycloakAccessToken(), or KeycloakUserInfo().
'==============================================================================

Class KeycloakAuth_Class
    Public BaseUrl
    Public Realm
    Public ClientId
    Public ClientSecret
    Public RedirectUri
    Public Scope
    Public LogoutRedirectUri
    Public SessionPrefix
    Public PendingLoginCookieMinutes
    Public AllowedClockSkewSeconds
    Public HttpResolveTimeoutMs
    Public HttpConnectTimeoutMs
    Public HttpSendTimeoutMs
    Public HttpReceiveTimeoutMs
    Public EnableDiagnosticLogging
    Public DiagnosticLogPath
    Public ErrorMessage
    Public LastStatus
    Public LastResponseText
    Public TokenResponse
    Public UserInfo

    Private Sub Class_Initialize()
        BaseUrl = ""
        Realm = ""
        ClientId = ""
        ClientSecret = ""
        RedirectUri = ""
        Scope = "openid profile email"
        LogoutRedirectUri = ""
        SessionPrefix = "Keycloak_"
        PendingLoginCookieMinutes = 15
        AllowedClockSkewSeconds = 300
        HttpResolveTimeoutMs = 5000
        HttpConnectTimeoutMs = 5000
        HttpSendTimeoutMs = 15000
        HttpReceiveTimeoutMs = 15000
        EnableDiagnosticLogging = False
        DiagnosticLogPath = ""
        ErrorMessage = ""
        LastStatus = 0
        LastResponseText = ""
        Set TokenResponse = Nothing
        Set UserInfo = Nothing
    End Sub

    Public Sub Configure(ByVal keycloakBaseUrl, ByVal keycloakRealm, ByVal keycloakClientId, ByVal keycloakClientSecret, ByVal keycloakRedirectUri)
        BaseUrl = Trim(CStr(keycloakBaseUrl))
        Realm = Trim(CStr(keycloakRealm))
        ClientId = Trim(CStr(keycloakClientId))
        ClientSecret = CStr(keycloakClientSecret)
        RedirectUri = Trim(CStr(keycloakRedirectUri))
    End Sub

    Public Sub ConfigureFromAppSettings()
        Dim sharedHttpTimeoutMs

        BaseUrl = KeycloakReadAppSetting("KeycloakBaseUrl", BaseUrl)
        Realm = KeycloakReadAppSetting("KeycloakRealm", Realm)
        ClientId = KeycloakReadAppSetting("KeycloakClientId", ClientId)
        ClientSecret = KeycloakReadAppSetting("KeycloakClientSecret", ClientSecret)
        RedirectUri = KeycloakReadAppSetting("KeycloakRedirectUri", RedirectUri)
        Scope = KeycloakReadAppSetting("KeycloakScope", Scope)
        LogoutRedirectUri = KeycloakReadAppSetting("KeycloakLogoutRedirectUri", LogoutRedirectUri)
        PendingLoginCookieMinutes = KeycloakReadAppSettingLong("KeycloakPendingLoginCookieMinutes", PendingLoginCookieMinutes)
        AllowedClockSkewSeconds = KeycloakReadAppSettingLong("KeycloakAllowedClockSkewSeconds", AllowedClockSkewSeconds)

        sharedHttpTimeoutMs = KeycloakReadAppSettingLong("KeycloakHttpTimeoutMs", 0)
        If sharedHttpTimeoutMs > 0 Then
            HttpResolveTimeoutMs = sharedHttpTimeoutMs
            HttpConnectTimeoutMs = sharedHttpTimeoutMs
            HttpSendTimeoutMs = sharedHttpTimeoutMs
            HttpReceiveTimeoutMs = sharedHttpTimeoutMs
        End If

        HttpResolveTimeoutMs = KeycloakReadAppSettingLong("KeycloakHttpResolveTimeoutMs", HttpResolveTimeoutMs)
        HttpConnectTimeoutMs = KeycloakReadAppSettingLong("KeycloakHttpConnectTimeoutMs", HttpConnectTimeoutMs)
        HttpSendTimeoutMs = KeycloakReadAppSettingLong("KeycloakHttpSendTimeoutMs", HttpSendTimeoutMs)
        HttpReceiveTimeoutMs = KeycloakReadAppSettingLong("KeycloakHttpReceiveTimeoutMs", HttpReceiveTimeoutMs)

        EnableDiagnosticLogging = KeycloakReadAppSettingBool("KeycloakEnableLogging", KeycloakReadAppSettingBool("EnableErrorLogging", EnableDiagnosticLogging))
        DiagnosticLogPath = KeycloakReadAppSetting("KeycloakLogPath", KeycloakReadAppSetting("ErrorLogPath", DiagnosticLogPath))
    End Sub

    Public Function IsConfigured()
        IsConfigured = (Len(NormalizeBaseUrl(BaseUrl)) > 0 And Len(Realm) > 0 And Len(ClientId) > 0 And Len(RedirectUri) > 0)
    End Function

    Public Function ValidateOperationalConfiguration(ByVal environmentName)
        Dim normalizedEnvironment

        ValidateOperationalConfiguration = True
        ErrorMessage = ""
        normalizedEnvironment = LCase(Trim(CStr(environmentName)))

        If normalizedEnvironment <> "production" Then Exit Function

        If Not IsHttpsUrl(BaseUrl) Then
            ErrorMessage = "Production Keycloak configuration requires an HTTPS KeycloakBaseUrl."
            ValidateOperationalConfiguration = False
            Exit Function
        End If

        If UrlTargetsLocalhost(BaseUrl) Then
            ErrorMessage = "Production Keycloak configuration cannot use a localhost KeycloakBaseUrl."
            ValidateOperationalConfiguration = False
            Exit Function
        End If

        If Not IsHttpsUrl(RedirectUri) Then
            ErrorMessage = "Production Keycloak configuration requires an HTTPS KeycloakRedirectUri."
            ValidateOperationalConfiguration = False
            Exit Function
        End If

        If UrlTargetsLocalhost(RedirectUri) Then
            ErrorMessage = "Production Keycloak configuration cannot use a localhost KeycloakRedirectUri."
            ValidateOperationalConfiguration = False
            Exit Function
        End If

        If Len(Trim(CStr(LogoutRedirectUri))) > 0 Then
            If Not IsHttpsUrl(LogoutRedirectUri) Then
                ErrorMessage = "Production Keycloak configuration requires an HTTPS KeycloakLogoutRedirectUri."
                ValidateOperationalConfiguration = False
                Exit Function
            End If

            If UrlTargetsLocalhost(LogoutRedirectUri) Then
                ErrorMessage = "Production Keycloak configuration cannot use a localhost KeycloakLogoutRedirectUri."
                ValidateOperationalConfiguration = False
                Exit Function
            End If
        End If
    End Function

    Public Function RealmBaseUrl()
        If Len(NormalizeBaseUrl(BaseUrl)) = 0 Or Len(Realm) = 0 Then
            RealmBaseUrl = ""
            Exit Function
        End If

        RealmBaseUrl = NormalizeBaseUrl(BaseUrl) & "/realms/" & Realm
    End Function

    Public Function AuthorizationEndpoint()
        AuthorizationEndpoint = RealmBaseUrl() & "/protocol/openid-connect/auth"
    End Function

    Public Function TokenEndpoint()
        TokenEndpoint = RealmBaseUrl() & "/protocol/openid-connect/token"
    End Function

    Public Function UserInfoEndpoint()
        UserInfoEndpoint = RealmBaseUrl() & "/protocol/openid-connect/userinfo"
    End Function

    Public Function LogoutEndpoint()
        LogoutEndpoint = RealmBaseUrl() & "/protocol/openid-connect/logout"
    End Function

    Public Function BuildLoginUrl(ByVal state, ByVal nonce)
        Dim loginUrl

        loginUrl = AuthorizationEndpoint()
        loginUrl = loginUrl & "?client_id=" & UrlEncode(ClientId)
        loginUrl = loginUrl & "&response_type=code"
        loginUrl = loginUrl & "&scope=" & UrlEncode(Scope)
        loginUrl = loginUrl & "&redirect_uri=" & UrlEncode(RedirectUri)

        If Len(state) > 0 Then loginUrl = loginUrl & "&state=" & UrlEncode(state)
        If Len(nonce) > 0 Then loginUrl = loginUrl & "&nonce=" & UrlEncode(nonce)

        BuildLoginUrl = loginUrl
    End Function

    Public Sub Login()
        Dim state, nonce, loginUrl

        If Not IsConfigured() Then
            Err.Raise vbObjectError + 5100, "KeycloakAuth.Login", "Keycloak is not configured. Set KeycloakBaseUrl, KeycloakRealm, KeycloakClientId, and KeycloakRedirectUri."
        End If

        If Not ValidateOperationalConfiguration(KeycloakReadAppSetting("Environment", "Development")) Then
            Call LogDiagnostic("ERROR", "config.invalid_for_environment", ErrorMessage, "environment=" & SafeLogValue(KeycloakReadAppSetting("Environment", "Development")))
            Err.Raise vbObjectError + 5101, "KeycloakAuth.Login", ErrorMessage
        End If

        Call ClearPendingLoginArtifacts()
        state = CreateRandomValue()
        nonce = CreateRandomValue()
        loginUrl = BuildLoginUrl(state, nonce)
        Call WritePendingLoginCookie(SessionPrefix & "State", state)
        Call WritePendingLoginCookie(SessionPrefix & "Nonce", nonce)
        Call LogDiagnostic("INFO", "login.pending_values_issued", "Issued new Keycloak login state and nonce.", "state=" & SensitiveValueSummary(state) & " nonce=" & SensitiveValueSummary(nonce))

        Response.Redirect loginUrl
    End Sub

    Public Function HandleCallback()
        Dim callbackError, callbackDescription, code, state, expectedNonce, accessToken, userData

        HandleCallback = False
        ErrorMessage = ""

        callbackError = Trim(CStr(Request.QueryString("error")))
        If Len(callbackError) > 0 Then
            callbackDescription = Trim(CStr(Request.QueryString("error_description")))
            ErrorMessage = "Keycloak returned an error: " & callbackError
            If Len(callbackDescription) > 0 Then ErrorMessage = ErrorMessage & " - " & callbackDescription
            Exit Function
        End If

        code = Trim(CStr(Request.QueryString("code")))
        If Len(code) = 0 Then
            ErrorMessage = "Keycloak callback did not include an authorization code."
            Call ClearPendingLoginArtifacts()
            Exit Function
        End If

        state = Trim(CStr(Request.QueryString("state")))
        If Not ValidateState(state) Then
            ErrorMessage = StateValidationError(state)
            Call ClearPendingLoginArtifacts()
            Exit Function
        End If

        expectedNonce = ReadRequestCookie(SessionPrefix & "Nonce")
        If Len(expectedNonce) = 0 Then
            ErrorMessage = "The login session nonce is missing, so the Keycloak callback cannot be validated."
            Call ClearPendingLoginArtifacts()
            Exit Function
        End If

        If Not ExchangeCode(code, expectedNonce) Then
            Call ClearPendingLoginArtifacts()
            Exit Function
        End If

        accessToken = DictionaryString(TokenResponse, "access_token")
        If Len(accessToken) > 0 Then
            Set userData = GetUserInfo(accessToken)
            If userData Is Nothing And Len(ErrorMessage) > 0 Then
                Call LogDiagnostic("WARN", "userinfo.unavailable", ErrorMessage, "status=" & CStr(LastStatus))
                ErrorMessage = ""
            End If
        End If

        Call ClearPendingLoginArtifacts()

        HandleCallback = True
    End Function

    Public Function ExchangeCode(ByVal code, ByVal expectedNonce)
        Dim body, tokenData

        ExchangeCode = False
        ErrorMessage = ""

        If Not IsConfigured() Then
            ErrorMessage = "Keycloak is not configured."
            Exit Function
        End If

        body = ""
        body = AddFormValue(body, "grant_type", "authorization_code")
        body = AddFormValue(body, "client_id", ClientId)
        body = AddFormValue(body, "client_secret", ClientSecret)
        body = AddFormValue(body, "code", code)
        body = AddFormValue(body, "redirect_uri", RedirectUri)

        Set tokenData = RequestToken(body)
        If tokenData Is Nothing Then Exit Function

        If Not ValidateTokenResponse(tokenData, True, expectedNonce) Then Exit Function

        Set TokenResponse = tokenData
        Call StoreTokenResponse(tokenData)
        ExchangeCode = True
    End Function

    Public Function RefreshAccessToken(ByVal refreshToken)
        Dim body, tokenData

        RefreshAccessToken = False
        ErrorMessage = ""

        If Len(refreshToken) = 0 Then refreshToken = GetSessionRefreshToken()
        If Len(refreshToken) = 0 Then
            ErrorMessage = "No refresh token is available."
            Exit Function
        End If

        body = ""
        body = AddFormValue(body, "grant_type", "refresh_token")
        body = AddFormValue(body, "client_id", ClientId)
        body = AddFormValue(body, "client_secret", ClientSecret)
        body = AddFormValue(body, "refresh_token", refreshToken)

        Set tokenData = RequestToken(body)
        If tokenData Is Nothing Then Exit Function

        If Not ValidateTokenResponse(tokenData, False, "") Then Exit Function

        Set TokenResponse = tokenData
        Call StoreTokenResponse(tokenData)
        RefreshAccessToken = True
    End Function

    Public Function GetUserInfo(ByVal accessToken)
        Dim parsed

        Set GetUserInfo = Nothing
        ErrorMessage = ""

        If Len(accessToken) = 0 Then accessToken = GetSessionAccessToken()
        If Len(accessToken) = 0 Then
            ErrorMessage = "No access token is available."
            Exit Function
        End If

        If Not SendBearerGet(UserInfoEndpoint(), accessToken) Then Exit Function
        If Not IsSuccessStatus(LastStatus) Then
            ErrorMessage = "Keycloak userinfo request failed with HTTP " & LastStatus & "."
            Exit Function
        End If

        Set parsed = ParseJsonObject(LastResponseText)
        If parsed Is Nothing Then Exit Function

        Set UserInfo = parsed
        Session(SessionPrefix & "UserInfoJson") = LastResponseText
        Set GetUserInfo = parsed
    End Function

    Public Function CurrentUser()
        Dim userInfoJson, idToken

        Set CurrentUser = Nothing

        If IsObject(UserInfo) Then
            If Not UserInfo Is Nothing Then
                Set CurrentUser = UserInfo
                Exit Function
            End If
        End If

        userInfoJson = ReadSessionValue(SessionPrefix & "UserInfoJson")
        If Len(userInfoJson) > 0 Then
            Set UserInfo = ParseJsonObject(userInfoJson)
            If Not UserInfo Is Nothing Then
                Set CurrentUser = UserInfo
                Exit Function
            End If
        End If

        idToken = GetSessionIdToken()
        If Len(idToken) > 0 Then
            Set CurrentUser = GetTokenClaims(idToken)
        End If
    End Function

    Public Function GetTokenClaims(ByVal token)
        Dim parts, payloadJson

        Set GetTokenClaims = Nothing
        If Len(token) = 0 Then Exit Function

        parts = Split(token, ".")
        If UBound(parts) < 1 Then
            ErrorMessage = "The token is not a JWT."
            Exit Function
        End If

        payloadJson = Base64UrlDecodeToString(parts(1))
        If Len(payloadJson) = 0 Then Exit Function

        Set GetTokenClaims = ParseJsonObject(payloadJson)
    End Function

    Public Function RoleClaims()
        Dim idToken

        Set RoleClaims = Nothing

        idToken = GetSessionIdToken()
        If Len(idToken) > 0 Then
            Set RoleClaims = GetTokenClaims(idToken)
            If Not RoleClaims Is Nothing Then Exit Function
        End If

        Set RoleClaims = CurrentUser()
    End Function

    Public Function HasRealmRole(ByVal roleName)
        Dim claims, realmAccess

        HasRealmRole = False
        Set claims = RoleClaims()
        If claims Is Nothing Then Exit Function

        Set realmAccess = NestedDictionary(claims, "realm_access")
        If realmAccess Is Nothing Then Exit Function

        HasRealmRole = CollectionContainsText(NestedDictionary(realmAccess, "roles"), roleName)
    End Function

    Public Function HasClientRole(ByVal clientId, ByVal roleName)
        Dim claims, resourceAccess, clientAccess

        HasClientRole = False
        Set claims = RoleClaims()
        If claims Is Nothing Then Exit Function

        Set resourceAccess = NestedDictionary(claims, "resource_access")
        If resourceAccess Is Nothing Then Exit Function

        Set clientAccess = NestedDictionary(resourceAccess, clientId)
        If clientAccess Is Nothing Then Exit Function

        HasClientRole = CollectionContainsText(NestedDictionary(clientAccess, "roles"), roleName)
    End Function

    Public Function RequireLogin(ByVal returnToPath)
        RequireLogin = True

        If IsLoggedIn() Then Exit Function

        If Len(Trim(CStr(returnToPath))) = 0 Then
            returnToPath = CurrentRequestPathAndQuery()
        End If

        Call SetPostLoginRedirectPath(returnToPath)
        Call Login()
        RequireLogin = False
    End Function

    Public Sub SetPostLoginRedirectPath(ByVal returnToPath)
        Dim normalizedPath

        normalizedPath = NormalizeRelativeReturnPath(returnToPath)
        If Len(normalizedPath) = 0 Then
            Session.Contents.Remove(SessionPrefix & "PostLoginRedirectPath")
            Exit Sub
        End If

        If IsAuthPath(normalizedPath) Then
            Session.Contents.Remove(SessionPrefix & "PostLoginRedirectPath")
            Exit Sub
        End If

        Session(SessionPrefix & "PostLoginRedirectPath") = normalizedPath
    End Sub

    Public Function ConsumePostLoginRedirectPath(ByVal fallbackPath)
        Dim storedPath, normalizedFallback

        storedPath = NormalizeRelativeReturnPath(ReadSessionValue(SessionPrefix & "PostLoginRedirectPath"))
        Session.Contents.Remove(SessionPrefix & "PostLoginRedirectPath")

        If Len(storedPath) > 0 Then
            ConsumePostLoginRedirectPath = storedPath
            Exit Function
        End If

        normalizedFallback = NormalizeRelativeReturnPath(fallbackPath)
        If Len(normalizedFallback) > 0 Then
            ConsumePostLoginRedirectPath = normalizedFallback
        Else
            ConsumePostLoginRedirectPath = "/"
        End If
    End Function

    Public Function NormalizeRelativeReturnPath(ByVal returnToPath)
        Dim normalizedPath

        NormalizeRelativeReturnPath = ""
        normalizedPath = Trim(CStr(returnToPath))
        If Len(normalizedPath) = 0 Then Exit Function

        normalizedPath = Replace(normalizedPath, vbCr, "")
        normalizedPath = Replace(normalizedPath, vbLf, "")

        If InStr(1, normalizedPath, "://", vbBinaryCompare) > 0 Then Exit Function
        If Left(normalizedPath, 2) = "//" Then Exit Function

        If Left(normalizedPath, 1) = "?" Then
            normalizedPath = "/" & normalizedPath
        End If

        If Left(normalizedPath, 1) <> "/" Then Exit Function

        NormalizeRelativeReturnPath = normalizedPath
    End Function

    Public Function ValidateIdToken(ByVal token, ByVal expectedNonce, ByVal requireNonce)
        Dim claims

        ValidateIdToken = False
        ErrorMessage = ""

        If Len(token) = 0 Then
            ErrorMessage = "Keycloak did not return an ID token."
            Call LogDiagnostic("ERROR", "id_token.missing", ErrorMessage, "")
            Exit Function
        End If

        Set claims = GetTokenClaims(token)
        If claims Is Nothing Then
            Call LogDiagnostic("ERROR", "id_token.decode_failed", ErrorMessage, "")
            Exit Function
        End If

        ValidateIdToken = ValidateIdTokenClaims(claims, expectedNonce, requireNonce)
    End Function

    Public Function IsLoggedIn()
        IsLoggedIn = (Len(GetSessionAccessToken()) > 0)
    End Function

    Public Function GetSessionAccessToken()
        GetSessionAccessToken = ReadSessionValue(SessionPrefix & "AccessToken")
    End Function

    Public Function GetSessionRefreshToken()
        GetSessionRefreshToken = ReadSessionValue(SessionPrefix & "RefreshToken")
    End Function

    Public Function GetSessionIdToken()
        GetSessionIdToken = ReadSessionValue(SessionPrefix & "IdToken")
    End Function

    Public Function BuildLogoutUrl(ByVal postLogoutRedirectUri)
        Dim logoutUrl, idToken

        logoutUrl = LogoutEndpoint()
        If Len(logoutUrl) = 0 Then
            BuildLogoutUrl = ""
            Exit Function
        End If

        If Len(postLogoutRedirectUri) = 0 Then postLogoutRedirectUri = LogoutRedirectUri

        logoutUrl = logoutUrl & "?client_id=" & UrlEncode(ClientId)

        idToken = GetSessionIdToken()
        If Len(idToken) > 0 Then logoutUrl = logoutUrl & "&id_token_hint=" & UrlEncode(idToken)
        If Len(postLogoutRedirectUri) > 0 Then logoutUrl = logoutUrl & "&post_logout_redirect_uri=" & UrlEncode(postLogoutRedirectUri)

        BuildLogoutUrl = logoutUrl
    End Function

    Public Sub Logout(ByVal postLogoutRedirectUri)
        Dim logoutUrl

        logoutUrl = BuildLogoutUrl(postLogoutRedirectUri)
        Call ClearSession()

        If Len(logoutUrl) > 0 Then Response.Redirect logoutUrl
    End Sub

    Public Sub ClearSession()
        On Error Resume Next
        Session.Contents.Remove(SessionPrefix & "AccessToken")
        Session.Contents.Remove(SessionPrefix & "RefreshToken")
        Session.Contents.Remove(SessionPrefix & "IdToken")
        Session.Contents.Remove(SessionPrefix & "TokenType")
        Session.Contents.Remove(SessionPrefix & "ExpiresAt")
        Session.Contents.Remove(SessionPrefix & "RefreshExpiresAt")
        Session.Contents.Remove(SessionPrefix & "UserInfoJson")
        Call ClearPendingLoginArtifacts()
        Set TokenResponse = Nothing
        Set UserInfo = Nothing
        On Error GoTo 0
    End Sub

    Private Function RequestToken(ByVal body)
        Dim parsedToken

        Set RequestToken = Nothing

        If Not SendFormPost(TokenEndpoint(), body) Then Exit Function
        If Not IsSuccessStatus(LastStatus) Then
            ErrorMessage = "Keycloak token request failed with HTTP " & LastStatus & "."
            Call LogDiagnostic("WARN", "token.http_error", ErrorMessage, BuildHttpDetail("POST", TokenEndpoint(), LastStatus, LastResponseText))
            Exit Function
        End If

        Set parsedToken = ParseJsonObject(LastResponseText)
        If parsedToken Is Nothing Then
            Call LogDiagnostic("ERROR", "token.parse_failed", ErrorMessage, BuildHttpDetail("POST", TokenEndpoint(), LastStatus, LastResponseText))
            Exit Function
        End If

        Set RequestToken = parsedToken
    End Function

    Private Sub StoreTokenResponse(ByVal tokenData)
        Dim expiresIn, refreshExpiresIn

        If tokenData Is Nothing Then Exit Sub

        If tokenData.Exists("access_token") Then Session(SessionPrefix & "AccessToken") = CStr(tokenData.Item("access_token"))
        If tokenData.Exists("refresh_token") Then Session(SessionPrefix & "RefreshToken") = CStr(tokenData.Item("refresh_token"))
        If tokenData.Exists("id_token") Then Session(SessionPrefix & "IdToken") = CStr(tokenData.Item("id_token"))
        If tokenData.Exists("token_type") Then Session(SessionPrefix & "TokenType") = CStr(tokenData.Item("token_type"))

        If tokenData.Exists("expires_in") Then
            expiresIn = CLng(tokenData.Item("expires_in"))
            Session(SessionPrefix & "ExpiresAt") = DateAdd("s", expiresIn, Now())
        End If

        If tokenData.Exists("refresh_expires_in") Then
            refreshExpiresIn = CLng(tokenData.Item("refresh_expires_in"))
            Session(SessionPrefix & "RefreshExpiresAt") = DateAdd("s", refreshExpiresIn, Now())
        End If
    End Sub

    Private Function ValidateState(ByVal callbackState)
        ValidateState = StatesMatch(ReadRequestCookie(SessionPrefix & "State"), callbackState)
    End Function

    Public Function StateValidationError(ByVal callbackState)
        Dim expectedState

        StateValidationError = ""
        expectedState = ReadRequestCookie(SessionPrefix & "State")

        If Len(NormalizeStateValue(expectedState)) = 0 Then
            StateValidationError = "Keycloak callback could not be matched to an active login session because the stored login state is missing. This usually means the login cookie expired, the callback URL was reloaded, or the callback was opened directly."
            Exit Function
        End If

        If Len(NormalizeStateValue(callbackState)) = 0 Then
            StateValidationError = "Keycloak callback did not include a state value."
            Exit Function
        End If

        StateValidationError = "Keycloak callback state did not match the active login session. This usually means another login attempt replaced the stored state or an older callback URL was replayed."
    End Function

    Private Function ValidateTokenResponse(ByVal tokenData, ByVal requireNonce, ByVal expectedNonce)
        Dim accessToken, tokenType, idToken

        ValidateTokenResponse = False
        If tokenData Is Nothing Then Exit Function

        accessToken = DictionaryString(tokenData, "access_token")
        If Len(accessToken) = 0 Then
            ErrorMessage = "Keycloak token response did not include an access token."
            Call LogDiagnostic("ERROR", "token.access_token_missing", ErrorMessage, "")
            Exit Function
        End If

        tokenType = DictionaryString(tokenData, "token_type")
        If Len(tokenType) > 0 Then
            If StrComp(tokenType, "Bearer", vbTextCompare) <> 0 Then
                ErrorMessage = "Keycloak token response returned an unexpected token type."
                Call LogDiagnostic("ERROR", "token.invalid_type", ErrorMessage, "token_type=" & SafeLogValue(tokenType))
                Exit Function
            End If
        End If

        idToken = DictionaryString(tokenData, "id_token")
        If requireNonce Then
            If Len(idToken) = 0 Then
                ErrorMessage = "Keycloak token response did not include an ID token for nonce validation."
                Call LogDiagnostic("ERROR", "id_token.required_for_nonce", ErrorMessage, "")
                Exit Function
            End If

        End If

        If Len(idToken) > 0 Then
            If Not ValidateIdToken(idToken, expectedNonce, requireNonce) Then Exit Function
        End If

        ValidateTokenResponse = True
    End Function

    Private Function ValidateIdTokenClaims(ByVal claims, ByVal expectedNonce, ByVal requireNonce)
        Dim issuer, subject, nonceValue, authorizedParty
        Dim nowEpoch, expiresAt, notBefore, issuedAt, audienceCount

        ValidateIdTokenClaims = False
        If claims Is Nothing Then Exit Function

        issuer = DictionaryString(claims, "iss")
        If Len(issuer) = 0 Then
            ErrorMessage = "Keycloak ID token is missing the issuer claim."
            Call LogDiagnostic("ERROR", "id_token.iss_missing", ErrorMessage, "")
            Exit Function
        End If

        If StrComp(issuer, RealmBaseUrl(), vbBinaryCompare) <> 0 Then
            ErrorMessage = "Keycloak ID token issuer did not match the configured realm."
            Call LogDiagnostic("ERROR", "id_token.iss_invalid", ErrorMessage, "expected_iss=" & SafeLogValue(RealmBaseUrl()) & " actual_iss=" & SafeLogValue(issuer))
            Exit Function
        End If

        subject = DictionaryString(claims, "sub")
        If Len(subject) = 0 Then
            ErrorMessage = "Keycloak ID token is missing the subject claim."
            Call LogDiagnostic("ERROR", "id_token.sub_missing", ErrorMessage, "")
            Exit Function
        End If

        If Not AudienceContainsClientId(claims, audienceCount) Then
            ErrorMessage = "Keycloak ID token audience did not include the configured client."
            Call LogDiagnostic("ERROR", "id_token.aud_invalid", ErrorMessage, "client_id=" & SafeLogValue(ClientId) & " aud=" & SafeLogValue(ClaimValueForLog(claims, "aud")))
            Exit Function
        End If

        If audienceCount > 1 Then
            authorizedParty = DictionaryString(claims, "azp")
            If Len(authorizedParty) = 0 Or StrComp(authorizedParty, ClientId, vbBinaryCompare) <> 0 Then
                ErrorMessage = "Keycloak ID token authorized party did not match the configured client."
                Call LogDiagnostic("ERROR", "id_token.azp_invalid", ErrorMessage, "client_id=" & SafeLogValue(ClientId) & " azp=" & SafeLogValue(authorizedParty))
                Exit Function
            End If
        End If

        If Not TryGetNumericClaim(claims, "exp", expiresAt) Then
            ErrorMessage = "Keycloak ID token is missing the expiration claim."
            Call LogDiagnostic("ERROR", "id_token.exp_missing", ErrorMessage, "")
            Exit Function
        End If

        nowEpoch = CurrentUnixTime()
        If (expiresAt + CLng(AllowedClockSkewSeconds)) < nowEpoch Then
            ErrorMessage = "Keycloak ID token has expired."
            Call LogDiagnostic("ERROR", "id_token.expired", ErrorMessage, "exp=" & CStr(expiresAt) & " now=" & CStr(nowEpoch))
            Exit Function
        End If

        If TryGetNumericClaim(claims, "nbf", notBefore) Then
            If (notBefore - CLng(AllowedClockSkewSeconds)) > nowEpoch Then
                ErrorMessage = "Keycloak ID token is not valid yet."
                Call LogDiagnostic("ERROR", "id_token.not_yet_valid", ErrorMessage, "nbf=" & CStr(notBefore) & " now=" & CStr(nowEpoch))
                Exit Function
            End If
        End If

        If TryGetNumericClaim(claims, "iat", issuedAt) Then
            If (issuedAt - CLng(AllowedClockSkewSeconds)) > nowEpoch Then
                ErrorMessage = "Keycloak ID token appears to have been issued in the future."
                Call LogDiagnostic("ERROR", "id_token.issued_at_invalid", ErrorMessage, "iat=" & CStr(issuedAt) & " now=" & CStr(nowEpoch))
                Exit Function
            End If
        End If

        If requireNonce Then
            If Len(expectedNonce) = 0 Then
                ErrorMessage = "The login session nonce is missing, so the Keycloak callback cannot be validated."
                Call LogDiagnostic("ERROR", "id_token.nonce_session_missing", ErrorMessage, "")
                Exit Function
            End If

            nonceValue = DictionaryString(claims, "nonce")
            If Len(nonceValue) = 0 Then
                ErrorMessage = "Keycloak ID token is missing the nonce claim."
                Call LogDiagnostic("ERROR", "id_token.nonce_missing", ErrorMessage, "")
                Exit Function
            End If

            If StrComp(nonceValue, expectedNonce, vbBinaryCompare) <> 0 Then
                ErrorMessage = "Keycloak ID token nonce did not match the active login session."
                Call LogDiagnostic("ERROR", "id_token.nonce_invalid", ErrorMessage, "expected_nonce=" & SensitiveValueSummary(expectedNonce) & " actual_nonce=" & SensitiveValueSummary(nonceValue))
                Exit Function
            End If
        End If

        ValidateIdTokenClaims = True
    End Function

    Private Function SendFormPost(ByVal url, ByVal body)
        Dim http

        SendFormPost = False
        LastStatus = 0
        LastResponseText = ""

        Set http = CreateHttpClient()
        If http Is Nothing Then Exit Function

        On Error Resume Next
        http.open "POST", url, False
        http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        http.setRequestHeader "Accept", "application/json"
        http.send body

        If Err.Number <> 0 Then
            ErrorMessage = "Keycloak HTTP POST failed: " & Err.Description
            Call LogDiagnostic("ERROR", "http.post_failed", ErrorMessage, BuildHttpDetail("POST", url, 0, ""))
            Err.Clear
        Else
            LastStatus = CLng(http.status)
            LastResponseText = CStr(http.responseText)
            SendFormPost = True
        End If

        Set http = Nothing
        On Error GoTo 0
    End Function

    Private Function SendBearerGet(ByVal url, ByVal bearerToken)
        Dim http

        SendBearerGet = False
        LastStatus = 0
        LastResponseText = ""

        Set http = CreateHttpClient()
        If http Is Nothing Then Exit Function

        On Error Resume Next
        http.open "GET", url, False
        http.setRequestHeader "Accept", "application/json"
        http.setRequestHeader "Authorization", "Bearer " & bearerToken
        http.send

        If Err.Number <> 0 Then
            ErrorMessage = "Keycloak HTTP GET failed: " & Err.Description
            Call LogDiagnostic("ERROR", "http.get_failed", ErrorMessage, BuildHttpDetail("GET", url, 0, ""))
            Err.Clear
        Else
            LastStatus = CLng(http.status)
            LastResponseText = CStr(http.responseText)
            SendBearerGet = True
        End If

        Set http = Nothing
        On Error GoTo 0
    End Function

    Private Function ParseJsonObject(ByVal jsonText)
        Dim parser

        Set ParseJsonObject = Nothing
        If Len(Trim(CStr(jsonText))) = 0 Then Exit Function

        On Error Resume Next
        Set parser = New aspJSON
        parser.loadJSON jsonText

        If Err.Number <> 0 Then
            ErrorMessage = "Unable to parse Keycloak JSON response: " & Err.Description
            Call LogDiagnostic("ERROR", "json.parse_failed", ErrorMessage, "json_length=" & CStr(Len(CStr(jsonText))))
            Err.Clear
        Else
            Set ParseJsonObject = parser.data
        End If

        On Error GoTo 0
    End Function

    Private Function Base64UrlDecodeToString(ByVal value)
        Dim base64Value, xml, node, bytes, stream

        Base64UrlDecodeToString = ""
        base64Value = Replace(Replace(CStr(value), "-", "+"), "_", "/")

        Do While (Len(base64Value) Mod 4) <> 0
            base64Value = base64Value & "="
        Loop

        On Error Resume Next
        Set xml = Server.CreateObject("MSXML2.DOMDocument.6.0")
        If Err.Number <> 0 Then
            Err.Clear
            Set xml = Server.CreateObject("MSXML2.DOMDocument")
        End If

        Set node = xml.createElement("base64")
        node.DataType = "bin.base64"
        node.Text = base64Value
        bytes = node.nodeTypedValue

        Set stream = Server.CreateObject("ADODB.Stream")
        stream.Type = 1
        stream.Open
        stream.Write bytes
        stream.Position = 0
        stream.Type = 2
        stream.Charset = "utf-8"
        Base64UrlDecodeToString = stream.ReadText
        stream.Close

        If Err.Number <> 0 Then
            ErrorMessage = "Unable to decode JWT payload: " & Err.Description
            Base64UrlDecodeToString = ""
            Call LogDiagnostic("ERROR", "jwt.decode_failed", ErrorMessage, "")
            Err.Clear
        End If

        Set stream = Nothing
        Set node = Nothing
        Set xml = Nothing
        On Error GoTo 0
    End Function

    Private Function NormalizeBaseUrl(ByVal value)
        value = Trim(CStr(value))

        Do While Right(value, 1) = "/"
            value = Left(value, Len(value) - 1)
        Loop

        NormalizeBaseUrl = value
    End Function

    Private Function CurrentRequestPathAndQuery()
        Dim requestPath, queryString

        CurrentRequestPathAndQuery = ""

        On Error Resume Next
        requestPath = Trim(CStr(Request.ServerVariables("HTTP_X_ORIGINAL_URL")))
        If Len(requestPath) = 0 Then requestPath = Trim(CStr(Request.ServerVariables("URL")))
        queryString = Trim(CStr(Request.ServerVariables("QUERY_STRING")))
        On Error GoTo 0

        If Len(requestPath) = 0 Then requestPath = "/"
        If Len(queryString) > 0 And InStr(1, requestPath, "?", vbBinaryCompare) = 0 Then
            requestPath = requestPath & "?" & queryString
        End If

        CurrentRequestPathAndQuery = requestPath
    End Function

    Private Function IsHttpsUrl(ByVal value)
        IsHttpsUrl = (LCase(Left(Trim(CStr(value)), 8)) = "https://")
    End Function

    Private Function UrlTargetsLocalhost(ByVal value)
        Dim normalizedValue

        normalizedValue = LCase(Trim(CStr(value)))
        UrlTargetsLocalhost = (InStr(1, normalizedValue, "://localhost", vbBinaryCompare) > 0 Or _
            InStr(1, normalizedValue, "://127.0.0.1", vbBinaryCompare) > 0 Or _
            InStr(1, normalizedValue, "://[::1]", vbBinaryCompare) > 0)
    End Function

    Private Function NestedDictionary(ByVal parentDictionary, ByVal key)
        Set NestedDictionary = Nothing

        If Not IsObject(parentDictionary) Then Exit Function
        If parentDictionary Is Nothing Then Exit Function
        If Not parentDictionary.Exists(key) Then Exit Function
        If Not IsObject(parentDictionary.Item(key)) Then Exit Function

        Set NestedDictionary = parentDictionary.Item(key)
    End Function

    Private Function CollectionContainsText(ByVal dictionary, ByVal expectedValue)
        Dim itemKey, itemValue

        CollectionContainsText = False
        If Len(Trim(CStr(expectedValue))) = 0 Then Exit Function
        If Not IsObject(dictionary) Then Exit Function
        If dictionary Is Nothing Then Exit Function

        For Each itemKey In dictionary.Keys
            itemValue = dictionary.Item(itemKey)
            If Not IsNull(itemValue) And Not IsEmpty(itemValue) Then
                If StrComp(CStr(itemValue), CStr(expectedValue), vbTextCompare) = 0 Then
                    CollectionContainsText = True
                    Exit Function
                End If
            End If
        Next
    End Function

    Private Function IsAuthPath(ByVal path)
        Dim normalizedPath

        normalizedPath = LCase(CStr(path))
        IsAuthPath = (Left(normalizedPath, 11) = "/auth/login" Or _
            Left(normalizedPath, 14) = "/auth/callback" Or _
            Left(normalizedPath, 12) = "/auth/logout")
    End Function

    Private Function AddFormValue(ByVal body, ByVal key, ByVal value)
        If Len(CStr(value)) = 0 Then
            AddFormValue = body
            Exit Function
        End If

        If Len(body) > 0 Then body = body & "&"
        AddFormValue = body & UrlEncode(key) & "=" & UrlEncode(value)
    End Function

    Private Function UrlEncode(ByVal value)
        UrlEncode = Server.URLEncode(CStr(value))
    End Function

    Private Function DictionaryString(ByVal dictionary, ByVal key)
        DictionaryString = ""

        If Not IsObject(dictionary) Then Exit Function
        If dictionary Is Nothing Then Exit Function
        If Not dictionary.Exists(key) Then Exit Function
        If IsNull(dictionary.Item(key)) Or IsEmpty(dictionary.Item(key)) Then Exit Function

        DictionaryString = CStr(dictionary.Item(key))
    End Function

    Private Function ReadSessionValue(ByVal key)
        Dim value

        ReadSessionValue = ""

        On Error Resume Next
        value = Session(key)
        If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
            Exit Function
        End If
        On Error GoTo 0

        If IsNull(value) Or IsEmpty(value) Then Exit Function
        ReadSessionValue = CStr(value)
    End Function

    Public Function EnsurePendingLoginValue(ByVal key)
        Dim value

        value = ReadPendingLoginValue(key)
        If Len(value) = 0 Then
            value = CreateRandomValue()
            Session(key) = value
            Call WritePendingLoginCookie(key, value)
        End If

        EnsurePendingLoginValue = value
    End Function

    Private Function ReadPendingLoginValue(ByVal key)
        ReadPendingLoginValue = ReadSessionValue(key)
        If Len(ReadPendingLoginValue) > 0 Then Exit Function

        ReadPendingLoginValue = ReadRequestCookie(key)
    End Function

    Private Sub ClearPendingLoginArtifacts()
        On Error Resume Next
        Session.Contents.Remove(SessionPrefix & "State")
        Session.Contents.Remove(SessionPrefix & "Nonce")
        Session.Contents.Remove(SessionPrefix & "LastIssuedState")
        Call ClearPendingLoginCookie(SessionPrefix & "PendingLogin")
        Call ClearPendingLoginCookie(SessionPrefix & "State")
        Call ClearPendingLoginCookie(SessionPrefix & "Nonce")
        Call ClearPendingLoginCookie(SessionPrefix & "LastIssuedState")
        Err.Clear
        On Error GoTo 0
    End Sub

    Private Function ReadRequestCookie(ByVal key)
        Dim cookieHeader, cookieParts, cookiePart, separatorPosition, currentName, currentValue

        ReadRequestCookie = ""
        If Len(Trim(CStr(key))) = 0 Then Exit Function

        On Error Resume Next
        cookieHeader = CStr(Request.ServerVariables("HTTP_COOKIE"))
        If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
            Exit Function
        End If
        On Error GoTo 0

        If Len(cookieHeader) = 0 Then Exit Function

        cookieParts = Split(cookieHeader, ";")
        For Each cookiePart In cookieParts
            separatorPosition = InStr(1, cookiePart, "=", vbBinaryCompare)
            If separatorPosition > 0 Then
                currentName = Trim(Left(cookiePart, separatorPosition - 1))
                currentName = DecodePercentEscapes(currentName)
                If StrComp(currentName, CStr(key), vbBinaryCompare) = 0 Then
                    currentValue = Mid(cookiePart, separatorPosition + 1)
                    ReadRequestCookie = Trim(DecodePercentEscapes(CStr(currentValue)))
                    Exit Function
                End If
            End If
        Next
    End Function

    Private Function DecodePercentEscapes(ByVal value)
        Dim outputValue, position, currentChar, hexValue

        outputValue = ""
        position = 1

        Do While position <= Len(CStr(value))
            currentChar = Mid(CStr(value), position, 1)

            If currentChar = "%" And (position + 2) <= Len(CStr(value)) Then
                hexValue = Mid(CStr(value), position + 1, 2)
                If IsHexByte(hexValue) Then
                    outputValue = outputValue & Chr(CLng("&H" & hexValue))
                    position = position + 3
                Else
                    outputValue = outputValue & currentChar
                    position = position + 1
                End If
            Else
                outputValue = outputValue & currentChar
                position = position + 1
            End If
        Loop

        DecodePercentEscapes = outputValue
    End Function

    Private Function IsHexByte(ByVal value)
        Dim i, currentChar

        IsHexByte = False
        If Len(CStr(value)) <> 2 Then Exit Function

        For i = 1 To 2
            currentChar = UCase(Mid(CStr(value), i, 1))
            If InStr(1, "0123456789ABCDEF", currentChar, vbBinaryCompare) = 0 Then Exit Function
        Next

        IsHexByte = True
    End Function

    Private Sub WritePendingLoginCookie(ByVal key, ByVal value)
        If Len(Trim(CStr(key))) = 0 Then Exit Sub

        On Error Resume Next
        Response.Cookies(key) = CStr(value)
        Response.Cookies(key).Path = "/"
        Response.Cookies(key).Expires = DateAdd("n", CLng(PendingLoginCookieMinutes), Now())
        Response.Cookies(key).HttpOnly = True
        Err.Clear
        On Error GoTo 0
    End Sub

    Private Sub ClearPendingLoginCookie(ByVal key)
        If Len(Trim(CStr(key))) = 0 Then Exit Sub

        On Error Resume Next
        Response.Cookies(key) = ""
        Response.Cookies(key).Path = "/"
        Response.Cookies(key).Expires = DateAdd("d", -1, Now())
        Response.Cookies(key).HttpOnly = True
        Err.Clear
        On Error GoTo 0
    End Sub

    Private Function NormalizeStateValue(ByVal value)
        Dim textValue, i, currentChar, normalizedValue

        textValue = UCase(Trim(CStr(value)))
        normalizedValue = ""

        For i = 1 To Len(textValue)
            currentChar = Mid(textValue, i, 1)
            If (currentChar >= "A" And currentChar <= "Z") Or (currentChar >= "0" And currentChar <= "9") Then
                normalizedValue = normalizedValue & currentChar
            End If
        Next

        NormalizeStateValue = normalizedValue
    End Function

    Private Function StatesMatch(ByVal leftValue, ByVal rightValue)
        Dim normalizedLeftValue, normalizedRightValue

        normalizedLeftValue = NormalizeStateValue(leftValue)
        normalizedRightValue = NormalizeStateValue(rightValue)

        StatesMatch = (Len(normalizedLeftValue) > 0 And Len(normalizedRightValue) > 0 And normalizedLeftValue = normalizedRightValue)
    End Function

    Private Function IsSuccessStatus(ByVal statusCode)
        IsSuccessStatus = (CLng(statusCode) >= 200 And CLng(statusCode) < 300)
    End Function

    Private Function CreateHttpClient()
        Dim http

        Set CreateHttpClient = Nothing
        On Error Resume Next

        Set http = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0")
        If Err.Number <> 0 Then
            Err.Clear
            Set http = Server.CreateObject("MSXML2.ServerXMLHTTP")
        End If

        If Err.Number <> 0 Then
            ErrorMessage = "Unable to create the Keycloak HTTP client: " & Err.Description
            Call LogDiagnostic("ERROR", "http.client_create_failed", ErrorMessage, "")
            Err.Clear
            Set http = Nothing
        Else
            Call ApplyHttpTimeouts(http)
        End If

        Set CreateHttpClient = http
        On Error GoTo 0
    End Function

    Private Sub ApplyHttpTimeouts(ByVal http)
        If Not IsObject(http) Then Exit Sub
        If http Is Nothing Then Exit Sub

        On Error Resume Next
        http.setTimeouts CLng(HttpResolveTimeoutMs), CLng(HttpConnectTimeoutMs), CLng(HttpSendTimeoutMs), CLng(HttpReceiveTimeoutMs)
        If Err.Number <> 0 Then
            Call LogDiagnostic("WARN", "http.timeout_apply_failed", "Unable to apply Keycloak HTTP timeouts.", "resolve_ms=" & CStr(HttpResolveTimeoutMs) & " connect_ms=" & CStr(HttpConnectTimeoutMs) & " send_ms=" & CStr(HttpSendTimeoutMs) & " receive_ms=" & CStr(HttpReceiveTimeoutMs))
            Err.Clear
        End If
        On Error GoTo 0
    End Sub

    Private Function AudienceContainsClientId(ByVal claims, audienceCount)
        Dim audienceValue, audienceCollection, audienceKey

        audienceCount = 0
        AudienceContainsClientId = False
        If Not IsObject(claims) Then Exit Function
        If claims Is Nothing Then Exit Function
        If Not claims.Exists("aud") Then Exit Function

        If IsObject(claims.Item("aud")) Then
            Set audienceCollection = claims.Item("aud")
            For Each audienceKey In audienceCollection.Keys
                audienceCount = audienceCount + 1
                If StrComp(CStr(audienceCollection.Item(audienceKey)), ClientId, vbBinaryCompare) = 0 Then
                    AudienceContainsClientId = True
                End If
            Next
            Set audienceCollection = Nothing
            Exit Function
        End If

        audienceValue = claims.Item("aud")
        If IsNull(audienceValue) Or IsEmpty(audienceValue) Then Exit Function
        audienceCount = 1
        AudienceContainsClientId = (StrComp(CStr(audienceValue), ClientId, vbBinaryCompare) = 0)
    End Function

    Private Function TryGetNumericClaim(ByVal claims, ByVal key, numericValue)
        Dim value

        TryGetNumericClaim = False
        numericValue = 0

        If Not IsObject(claims) Then Exit Function
        If claims Is Nothing Then Exit Function
        If Not claims.Exists(key) Then Exit Function

        value = claims.Item(key)
        If IsNull(value) Or IsEmpty(value) Then Exit Function
        If Not IsNumeric(value) Then Exit Function

        numericValue = CLng(value)
        TryGetNumericClaim = True
    End Function

    Private Function ClaimValueForLog(ByVal claims, ByVal key)
        Dim value, claimCollection, claimKey, combinedValue

        ClaimValueForLog = ""
        If Not IsObject(claims) Then Exit Function
        If claims Is Nothing Then Exit Function
        If Not claims.Exists(key) Then Exit Function

        If IsObject(claims.Item(key)) Then
            Set claimCollection = claims.Item(key)
            combinedValue = ""
            For Each claimKey In claimCollection.Keys
                If Len(combinedValue) > 0 Then combinedValue = combinedValue & ","
                combinedValue = combinedValue & CStr(claimCollection.Item(claimKey))
            Next
            ClaimValueForLog = combinedValue
            Set claimCollection = Nothing
            Exit Function
        End If

        value = claims.Item(key)
        If IsNull(value) Or IsEmpty(value) Then Exit Function
        ClaimValueForLog = CStr(value)
    End Function

    Private Function CurrentUnixTime()
        CurrentUnixTime = DateDiff("s", CDate("01/01/1970 00:00:00"), UtcNowValue())
    End Function

    Private Function UtcNowValue()
        Dim biasMinutes, service, utcTimes, utcItem

        UtcNowValue = Now()

        If TryGetActiveUtcBiasMinutes(biasMinutes) Then
            UtcNowValue = DateAdd("n", CLng(biasMinutes), Now())
            Exit Function
        End If

        On Error Resume Next
        Set service = GetObject("winmgmts:root\cimv2")
        Set utcTimes = service.ExecQuery("SELECT * FROM Win32_UTCTime")
        For Each utcItem In utcTimes
            UtcNowValue = DateSerial(utcItem.Year, utcItem.Month, utcItem.Day) + TimeSerial(utcItem.Hour, utcItem.Minute, utcItem.Second)
            Exit For
        Next
        Err.Clear
        Set utcItem = Nothing
        Set utcTimes = Nothing
        Set service = Nothing
        On Error GoTo 0
    End Function

    Private Function TryGetActiveUtcBiasMinutes(ByRef biasMinutes)
        Dim shell, value

        TryGetActiveUtcBiasMinutes = False
        biasMinutes = 0

        On Error Resume Next
        Set shell = Server.CreateObject("WScript.Shell")
        value = shell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")

        If Err.Number = 0 Then
            biasMinutes = CLng(value)
            TryGetActiveUtcBiasMinutes = True
        Else
            Err.Clear
        End If

        Set shell = Nothing
        On Error GoTo 0
    End Function

    Private Function BuildHttpDetail(ByVal method, ByVal url, ByVal statusCode, ByVal responseText)
        BuildHttpDetail = "method=" & SafeLogValue(method) & " url=" & SafeLogValue(url) & " status=" & CStr(statusCode) & " resolve_ms=" & CStr(HttpResolveTimeoutMs) & " connect_ms=" & CStr(HttpConnectTimeoutMs) & " send_ms=" & CStr(HttpSendTimeoutMs) & " receive_ms=" & CStr(HttpReceiveTimeoutMs)
        If Len(responseText) > 0 Then
            BuildHttpDetail = BuildHttpDetail & " response_length=" & CStr(Len(CStr(responseText)))
        End If
    End Function

    Private Sub LogDiagnostic(ByVal level, ByVal eventName, ByVal message, ByVal detail)
        Dim logEntry, appendValue

        logEntry = "[" & Replace(CStr(UtcNowValue()), vbCrLf, " ") & "] [Keycloak] level=" & UCase(CStr(level)) & " event=" & SafeLogValue(eventName) & " client_id=" & SafeLogValue(ClientId) & " realm=" & SafeLogValue(Realm) & " message=" & SafeLogValue(message)
        If Len(detail) > 0 Then logEntry = logEntry & " detail=" & SafeLogValue(detail)

        appendValue = "kc " & Left(CStr(eventName) & " " & TruncateForLog(message, 48), 80)

        On Error Resume Next
        Response.AppendToLog appendValue
        If EnableDiagnosticLogging And Len(DiagnosticLogPath) > 0 Then
            Call AppendLogFile(logEntry)
        End If
        Err.Clear
        On Error GoTo 0
    End Sub

    Private Sub AppendLogFile(ByVal logEntry)
        Dim fso, logFile

        If Len(DiagnosticLogPath) = 0 Then Exit Sub

        On Error Resume Next
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(DiagnosticLogPath) Then
            Set logFile = fso.OpenTextFile(DiagnosticLogPath, 8, False)
        Else
            Set logFile = fso.CreateTextFile(DiagnosticLogPath, True)
        End If

        logFile.WriteLine logEntry
        logFile.Close

        Set logFile = Nothing
        Set fso = Nothing
        Err.Clear
        On Error GoTo 0
    End Sub

    Private Function TruncateForLog(ByVal value, ByVal maxLength)
        Dim textValue

        textValue = CStr(value)
        If Len(textValue) <= CLng(maxLength) Then
            TruncateForLog = textValue
        Else
            TruncateForLog = Left(textValue, CLng(maxLength) - 3) & "..."
        End If
    End Function

    Private Function SafeLogValue(ByVal value)
        Dim textValue

        textValue = Replace(CStr(value), vbCr, " ")
        textValue = Replace(textValue, vbLf, " ")
        textValue = Replace(textValue, "|", "/")
        SafeLogValue = Trim(textValue)
    End Function

    Private Function SensitiveValueSummary(ByVal value)
        SensitiveValueSummary = "len=" & CStr(Len(CStr(value)))
    End Function

    Private Function CreateRandomValue()
        Dim guidProvider, rawValue

        Randomize
        rawValue = ""

        On Error Resume Next
        Set guidProvider = Server.CreateObject("Scriptlet.TypeLib")
        If Err.Number = 0 Then rawValue = guidProvider.Guid
        If Err.Number <> 0 Or Len(rawValue) = 0 Then
            Err.Clear
            rawValue = CStr(Now()) & "-" & CStr(Timer) & "-" & CStr(Rnd())
        End If
        On Error GoTo 0

        rawValue = Replace(rawValue, "{", "")
        rawValue = Replace(rawValue, "}", "")
        rawValue = Replace(rawValue, "-", "")
        rawValue = Replace(rawValue, " ", "")
        rawValue = Replace(rawValue, ":", "")
        rawValue = Replace(rawValue, "/", "")
        rawValue = Replace(rawValue, ".", "")

        CreateRandomValue = rawValue
    End Function
End Class

Function KeycloakReadAppSetting(ByVal key, ByVal fallbackValue)
    Dim value

    KeycloakReadAppSetting = fallbackValue

    On Error Resume Next
    value = GetAppSetting(key)
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        Exit Function
    End If
    On Error GoTo 0

    If IsNull(value) Or IsEmpty(value) Then Exit Function
    If Len(CStr(value)) = 0 Then Exit Function
    If LCase(CStr(value)) = "nothing" Then Exit Function

    KeycloakReadAppSetting = CStr(value)
End Function

Function KeycloakReadAppSettingBool(ByVal key, ByVal fallbackValue)
    Dim value

    KeycloakReadAppSettingBool = CBool(fallbackValue)
    value = LCase(Trim(CStr(KeycloakReadAppSetting(key, ""))))

    If Len(value) = 0 Then Exit Function

    Select Case value
        Case "true", "1", "yes", "on"
            KeycloakReadAppSettingBool = True
        Case "false", "0", "no", "off"
            KeycloakReadAppSettingBool = False
    End Select
End Function

Function KeycloakReadAppSettingLong(ByVal key, ByVal fallbackValue)
    Dim value

    KeycloakReadAppSettingLong = CLng(fallbackValue)
    value = KeycloakReadAppSetting(key, "")

    If Len(Trim(CStr(value))) = 0 Then Exit Function
    If Not IsNumeric(value) Then Exit Function

    KeycloakReadAppSettingLong = CLng(value)
End Function

Dim KeycloakAuth_Class__Singleton
Function KeycloakAuth()
    If IsEmpty(KeycloakAuth_Class__Singleton) Then
        Set KeycloakAuth_Class__Singleton = New KeycloakAuth_Class
        Call KeycloakAuth_Class__Singleton.ConfigureFromAppSettings()
    End If

    Set KeycloakAuth = KeycloakAuth_Class__Singleton
End Function

Function Keycloak()
    Set Keycloak = KeycloakAuth()
End Function

Sub KeycloakLogin()
    Dim auth
    Set auth = KeycloakAuth()
    Call auth.Login()
End Sub

Function KeycloakHandleCallback()
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakHandleCallback = auth.HandleCallback()
End Function

Function KeycloakIsLoggedIn()
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakIsLoggedIn = auth.IsLoggedIn()
End Function

Function KeycloakAccessToken()
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakAccessToken = auth.GetSessionAccessToken()
End Function

Function KeycloakRefreshToken()
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakRefreshToken = auth.GetSessionRefreshToken()
End Function

Function KeycloakIdToken()
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakIdToken = auth.GetSessionIdToken()
End Function

Function KeycloakCurrentUser()
    Dim auth
    Set auth = KeycloakAuth()
    Set KeycloakCurrentUser = auth.CurrentUser()
End Function

Function KeycloakUserInfo()
    Dim auth
    Set auth = KeycloakAuth()
    Set KeycloakUserInfo = auth.GetUserInfo("")
End Function

Function KeycloakTokenClaims(ByVal token)
    Dim auth
    Set auth = KeycloakAuth()
    Set KeycloakTokenClaims = auth.GetTokenClaims(token)
End Function

Function KeycloakRequireLogin(ByVal returnToPath)
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakRequireLogin = auth.RequireLogin(returnToPath)
End Function

Sub KeycloakSetPostLoginRedirectPath(ByVal returnToPath)
    Dim auth
    Set auth = KeycloakAuth()
    Call auth.SetPostLoginRedirectPath(returnToPath)
End Sub

Function KeycloakConsumePostLoginRedirectPath(ByVal fallbackPath)
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakConsumePostLoginRedirectPath = auth.ConsumePostLoginRedirectPath(fallbackPath)
End Function

Function KeycloakHasRealmRole(ByVal roleName)
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakHasRealmRole = auth.HasRealmRole(roleName)
End Function

Function KeycloakHasClientRole(ByVal clientId, ByVal roleName)
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakHasClientRole = auth.HasClientRole(clientId, roleName)
End Function

Function KeycloakLogoutUrl(ByVal postLogoutRedirectUri)
    Dim auth
    Set auth = KeycloakAuth()
    KeycloakLogoutUrl = auth.BuildLogoutUrl(postLogoutRedirectUri)
End Function

Sub KeycloakLogout(ByVal postLogoutRedirectUri)
    Dim auth
    Set auth = KeycloakAuth()
    Call auth.Logout(postLogoutRedirectUri)
End Sub
%>