<% ' ==== Pustaka SSO X-Guard untuk ASP Classic: bagian VBScript ================ ' Salin apa adanya. Yang disesuaikan hanya xg_config.asp dan xg_aplikasi.asp. Dim xgHttpStatus, xgHttpTeks, xgHttpGalat, xgHttpTanggal ' 64 karakter hex dari dua GUID acak Windows. Jangan pakai Rnd: mudah ditebak. Function xgAcak() xgAcak = xgGuidHex() & xgGuidHex() End Function Function xgGuidHex() Dim tl Set tl = Server.CreateObject("Scriptlet.TypeLib") xgGuidHex = LCase(Replace(Mid(tl.Guid, 2, 36), "-", "")) Set tl = Nothing End Function ' Tujuan setelah login hanya boleh path di aplikasi ini (bukan http://... atau //...), supaya halaman login tidak bisa ' dipakai mengalihkan user ke situs lain. Function xgPathAman(p) Dim re Set re = New RegExp re.Pattern = "^/([^/\\\x00-\x1f][^\\\x00-\x1f]*)?$" If re.Test(p & "") Then xgPathAman = p & "" Else xgPathAman = XG_HALAMAN_AWAL End If Set re = Nothing End Function ' Panggilan HTTPS dari server ke X-Guard. otorisasi = isi header Authorization (boleh kosong). ' Hasil ada di xgHttpStatus, xgHttpTeks, xgHttpGalat, xgHttpTanggal. Sub xgPanggil(metode, url, body, otorisasi) Dim http xgHttpStatus = 0 xgHttpTeks = "" xgHttpGalat = "" xgHttpTanggal = "" On Error Resume Next Set http = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0") If Err.Number <> 0 Then xgHttpGalat = "MSXML2.ServerXMLHTTP.6.0 tidak tersedia: " & Err.Description Exit Sub End If http.setTimeouts 5000, 5000, 10000, 15000 http.open metode, url, False If metode = "POST" Then http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" If Len(otorisasi) > 0 Then http.setRequestHeader "Authorization", otorisasi http.setRequestHeader "Accept", "application/json" http.send body If Err.Number <> 0 Then xgHttpGalat = "0x" & Hex(Err.Number) & " " & Trim(Replace(Err.Description, vbCrLf, " ")) Exit Sub End If xgHttpStatus = http.status xgHttpTeks = http.responseText xgHttpTanggal = http.getResponseHeader("Date") Set http = Nothing End Sub ' Client ID dan secret dikirim sebagai HTTP Basic (client_secret_basic, bawaan aplikasi di konsol X-Guard). Function xgBasicAuth() xgBasicAuth = "Basic " & xgBase64Teks(xgUrlEncode(XG_CLIENT_ID) & ":" & xgUrlEncode(XG_CLIENT_SECRET)) End Function Sub xgTanpaCache() Response.CacheControl = "no-store" Response.Expires = -1 End Sub ' Pesan galat untuk user. Silakan disesuaikan dengan tampilan aplikasi. ' Sengaja tanpa Response.Status: IIS bisa mengganti isi halaman berstatus 4xx dengan halaman galat bawaannya. Sub xgTampilkanGalat(kode, pesan) Response.AppendToLog "xg_gagal_" & kode Response.Write "Gagal masuk" Response.Write "

Gagal masuk

" & Server.HTMLEncode(pesan) & "

" Response.Write "

Coba masuk lagi

" Response.End End Sub ' Mulai login. silent = True: tanpa tampilan apa pun (prompt=none). Sub xgMulaiLogin(tujuan, silent) Dim state, nonce, verifier, url state = xgAcak() nonce = xgAcak() verifier = xgAcak() Session("xg_state") = state Session("xg_nonce") = nonce Session("xg_verifier") = verifier Session("xg_next") = xgPathAman(tujuan) If silent Then Session("xg_silent") = "1" Else Session("xg_silent") = "0" url = XG_AUTH_URL & "?response_type=code" & _ "&client_id=" & xgUrlEncode(XG_CLIENT_ID) & _ "&redirect_uri=" & xgUrlEncode(XG_REDIRECT_URI) & _ "&scope=openid%20profile%20email" & _ "&state=" & state & "&nonce=" & nonce & _ "&code_challenge=" & xgPkceChallenge(verifier) & "&code_challenge_method=S256" If silent Then url = url & "&prompt=none" Response.Redirect url End Sub ' Sudah login: sesi berisi pengguna X-Guard, dan cookie pengikat cocok dengan sesi. Function xgSudahLogin() Dim c c = Request.Cookies(XG_COOKIE) & "" xgSudahLogin = (Len(Session("xg_sub") & "") > 0 And Len(c) > 0 And c = (Session("xg_auth") & "")) End Function ' Mengakhiri sesi di aplikasi ini. Session.Abandon baru berlaku setelah halaman selesai, jadi sesudah ini harus ' redirect, jangan langsung xgMulaiLogin. Sub xgHapusSesi() Session("xg_sub") = "" Session("xg_auth") = "" Session("xg_id_token") = "" Response.AddHeader "Set-Cookie", XG_COOKIE & "=; Path=/; Max-Age=0; Secure; HttpOnly; SameSite=Lax" Session.Abandon End Sub ' Kode penolakan login senyap yang artinya "pengguna perlu login lagi". Function xgPerluLoginBiasa(galat) Select Case galat Case "login_required", "interaction_required", "consent_required", "account_selection_required" xgPerluLoginBiasa = True Case Else xgPerluLoginBiasa = False End Select End Function ' Isi halaman callback.asp. Sub xgProsesCallback() Dim state, code, galat, tujuan, silent, nonce, verifier, idToken, payload, alasan, pesan, xg_sub, kunci xgTanpaCache state = Request.QueryString("state") & "" code = Request.QueryString("code") & "" galat = Request.QueryString("error") & "" ' Browser kadang membuka callback dua kali. Code hanya bisa ditukar sekali, jadi kalau yang pertama sudah berhasil, ' lanjutkan saja. If Len(Session("xg_state") & "") = 0 And xgSudahLogin() Then Response.Redirect xgPathAman(Session("xg_next") & "") End If ' state membuktikan callback ini kelanjutan login dari browser yang sama (anti-CSRF). If Len(state) = 0 Or state <> (Session("xg_state") & "") Then xgTampilkanGalat "state", "Sesi login sudah kedaluwarsa atau dibuka dari tab lain. Silakan coba masuk lagi." End If tujuan = xgPathAman(Session("xg_next") & "") silent = ((Session("xg_silent") & "") = "1") nonce = Session("xg_nonce") & "" verifier = Session("xg_verifier") & "" Session("xg_state") = "" Session("xg_nonce") = "" Session("xg_verifier") = "" If Len(galat) > 0 Then If silent And xgPerluLoginBiasa(galat) Then ' Sesi X-Guard tidak ada lagi (keluar di aplikasi lain, kedaluwarsa, atau akun dinonaktifkan): sesi di ' aplikasi ini ikut berakhir, lalu login biasa. xgHapusSesi Response.Redirect XG_LOGIN_PATH & "?next=" & xgUrlEncode(tujuan) End If If silent Then xgHapusSesi If galat = "access_denied" Then xgTampilkanGalat "access_denied", "Akun Anda belum diberi akses ke aplikasi ini. Hubungi admin organisasi Anda." End If xgTampilkanGalat "xg_lain", "X-Guard menolak permintaan login (" & galat & ")." End If If Len(code) = 0 Then xgTampilkanGalat "tanpa_code", "Jawaban X-Guard tidak lengkap. Silakan coba masuk lagi." xgPanggil "POST", XG_TOKEN_URL, "grant_type=authorization_code" & _ "&code=" & xgUrlEncode(code) & _ "&redirect_uri=" & xgUrlEncode(XG_REDIRECT_URI) & _ "&code_verifier=" & xgUrlEncode(verifier), xgBasicAuth() If Len(xgHttpGalat) > 0 Then xgTampilkanGalat "koneksi", "Server aplikasi gagal menghubungi X-Guard. Hubungi admin aplikasi." End If If xgHttpStatus <> 200 Then xgTampilkanGalat "token_" & xgJsonTeks(xgHttpTeks, "error"), "X-Guard menolak penukaran login. Silakan coba masuk lagi." End If idToken = xgJsonTeks(xgHttpTeks, "id_token") payload = xgPayloadIdToken(idToken) alasan = xgPeriksaIdToken(payload, XG_ISSUER, XG_CLIENT_ID, nonce, 120) If Len(alasan) > 0 Then xgTampilkanGalat alasan, "Identitas dari X-Guard tidak valid. Silakan coba masuk lagi." xg_sub = xgJsonTeks(payload, "sub") ' Cek ulang berkala ternyata mendapati pengguna X-Guard yang berbeda di browser ini. If silent And Len(Session("xg_sub") & "") > 0 And (Session("xg_sub") & "") <> xg_sub Then xgHapusSesi Response.Redirect XG_LOGIN_PATH & "?next=" & xgUrlEncode(tujuan) End If ' Tautkan ke pengguna aplikasi (xg_aplikasi.asp). Hasil "" = boleh masuk. pesan = xgLoginLokal(xg_sub, xgJsonTeks(payload, "email"), xgJsonTeks(payload, "name"), _ (xgJsonTeks(payload, "email_verified") = "true")) If Len(pesan) > 0 Then xgTampilkanGalat "ditolak_aplikasi", pesan ' ASP tidak bisa mengganti SessionID. Cookie acak ini mengikat sesi ke browser yang menyelesaikan login, supaya ' SessionID yang ditanam orang lain tidak berguna. kunci = xgAcak() Session("xg_sub") = xg_sub Session("xg_id_token") = idToken Session("xg_sid") = xgJsonTeks(payload, "sid") Session("xg_auth") = kunci Session("xg_cek_berikut") = xgDetikSekarang() + XG_CEK_ULANG_MENIT * 60 Response.AddHeader "Set-Cookie", XG_COOKIE & "=" & kunci & "; Path=/; Secure; HttpOnly; SameSite=Lax" Response.Redirect tujuan End Sub ' Taruh di awal halaman yang wajib login. modeAjax = True untuk halaman yang dipanggil lewat AJAX: jawab 401, jangan ' redirect. Sub xgWajibLogin(modeAjax) If Not xgSudahLogin() Then If modeAjax Then Response.Status = "401 Unauthorized" Response.End End If ' Coba senyap dulu: bila sesi X-Guard masih ada, pengguna tidak perlu mengklik apa pun. Response.Redirect XG_LOGIN_PATH & "?silent=1&next=" & xgUrlEncode(xgTujuanHalamanIni()) End If ' Cek ulang berkala: menangkap akun yang dinonaktifkan, akses yang dicabut, atau sesi X-Guard yang sudah berakhir. ' Hanya GET non-AJAX, supaya isian form tidak hilang. If XG_CEK_ULANG_MENIT > 0 And Not modeAjax And Request.ServerVariables("REQUEST_METHOD") = "GET" Then If xgDetikSekarang() >= CDbl("0" & Session("xg_cek_berikut")) Then Response.Redirect XG_LOGIN_PATH & "?silent=1&next=" & xgUrlEncode(xgTujuanHalamanIni()) End If End If End Sub Function xgTujuanHalamanIni() xgTujuanHalamanIni = Request.ServerVariables("URL") If Len(Request.ServerVariables("QUERY_STRING")) > 0 Then xgTujuanHalamanIni = xgTujuanHalamanIni & "?" & Request.ServerVariables("QUERY_STRING") End If End Function ' Isi halaman logout.asp: keluar dari aplikasi ini lalu dari sesi X-Guard (semua aplikasi organisasi ikut keluar). Sub xgLogout() Dim idToken xgTanpaCache idToken = Session("xg_id_token") & "" xgHapusSesi If Len(idToken) = 0 Then Response.Redirect XG_POST_LOGOUT_URI Response.Redirect XG_LOGOUT_URL & "?id_token_hint=" & xgUrlEncode(idToken) & _ "&post_logout_redirect_uri=" & xgUrlEncode(XG_POST_LOGOUT_URI) End Sub ' Body permintaan mentah dalam hex (maksimal 64 KB). Function xgBodyHex() Dim n, data, dom, el xgBodyHex = "" n = Request.TotalBytes If n <= 0 Or n > 65536 Then Exit Function data = Request.BinaryRead(n) Set dom = Server.CreateObject("MSXML2.DOMDocument.6.0") Set el = dom.createElement("b") el.dataType = "bin.hex" el.nodeTypedValue = data xgBodyHex = el.text End Function Sub xgJawabWebhook(status, teks) Response.Status = status Response.ContentType = "text/plain" Response.Write teks Response.End End Sub ' Isi halaman webhook.asp: periksa tanda tangan, lalu teruskan event ke xgTerimaEvent (xg_aplikasi.asp). ' Jawaban 2xx = diterima; selain itu X-Guard mencoba lagi sampai 24 jam. Sub xgProsesWebhook() Dim bodyHex, alasan, body, idEvent, hasil xgTanpaCache If Request.ServerVariables("REQUEST_METHOD") <> "POST" Then xgJawabWebhook "405 Method Not Allowed", "hanya POST" bodyHex = xgBodyHex() If Len(bodyHex) = 0 Then xgJawabWebhook "400 Bad Request", "body kosong atau terlalu besar" alasan = xgPeriksaWebhook(XG_WEBHOOK_SECRET, Request.ServerVariables("HTTP_X_XGUARD_TIMESTAMP") & "", _ Request.ServerVariables("HTTP_X_XGUARD_SIGNATURE") & "", bodyHex, 300) If Len(alasan) > 0 Then Response.AppendToLog "xg_webhook_" & alasan xgJawabWebhook "401 Unauthorized", alasan End If body = xgHexTeks(bodyHex) idEvent = xgJsonTeks(body, "id") If Len(idEvent) = 0 Or idEvent <> (Request.ServerVariables("HTTP_X_XGUARD_EVENT_ID") & "") Then xgJawabWebhook "400 Bad Request", "id event tidak cocok" End If hasil = xgTerimaEvent(idEvent, xgJsonTeks(body, "type"), xgJsonTeks(body, "sub"), xgJsonTeks(body, "email"), _ xgJsonTeks(body, "access")) If Len(hasil) > 0 Then Response.AppendToLog "xg_webhook_gagal" xgJawabWebhook "500 Internal Server Error", hasil End If xgJawabWebhook "200 OK", "ok" End Sub %>