├── README.md ├── external ├── aspJSON.asp ├── base64.asp └── sha256.wsc ├── jwt.asp └── utils.asp /README.md: -------------------------------------------------------------------------------- 1 | ## Classic ASP JWT 2 | 3 | A JWT implementation in Classic ASP, currently only supports `JWTEncode(dictionary, secret)`. 4 | 5 | ### Usage 6 | 7 | ```asp 8 | 9 | <% 10 | Dim sKey, dAttributes, sToken 11 | 12 | sKey = "Shared Secret" 13 | Set dAttributes=Server.CreateObject("Scripting.Dictionary") 14 | 15 | ' The UniqueString and SecsSinceEpoch functions are provided by this implementation 16 | dAttributes.Add "jti", UniqueString 17 | dAttributes.Add "iat", SecsSinceEpoch 18 | dAttributes.Add "name", "Roger" 19 | dAttributes.Add "email", "roger@example.com" 20 | 21 | sToken = JWTEncode(dAttributes, sKey) 22 | %> 23 | ``` 24 | 25 | ### License 26 | 27 | The depdendencies in the `external` folder are subject to their respective licenses as noted in the files. This license only pertains to the other files in this repository. 28 | 29 | Copyright 2013 Zendesk 30 | 31 | Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. 32 | You may obtain a copy of the License at 33 | 34 | http://www.apache.org/licenses/LICENSE-2.0 35 | 36 | Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. 37 | -------------------------------------------------------------------------------- /external/aspJSON.asp: -------------------------------------------------------------------------------- 1 | <% 2 | 'July 2012 - Version 1.0 by Gerrit van Kuipers - http://www.aspjson.com/ 3 | Class aspJSON 4 | Public data 5 | Private p_JSONstring 6 | Private p_datatype 7 | 8 | Private Sub Class_Initialize() 9 | Set data = Collection() 10 | p_datatype = "{}" 11 | End Sub 12 | 13 | Private Sub Class_Terminate() 14 | Set data = Nothing 15 | End Sub 16 | 17 | Public Function loadJSON(strInput) 18 | p_JSONstring = CleanUpJSONstring(Trim(strInput)) 19 | lines = Split(p_JSONstring, vbCrLf) 20 | 21 | Dim level(99) 22 | currentlevel = 1 23 | Set level(currentlevel) = data 24 | For Each line In lines 25 | currentkey = "" 26 | currentvalue = "" 27 | If Instr(line, ":") > 0 Then 28 | '"created":"2010-04-30 09:20:09" 29 | 30 | in_string = False 31 | in_escape = False 32 | For i_tmp = 1 To Len(line) 33 | If in_escape Then 34 | in_escape = False 35 | Else 36 | char = Mid(line, i_tmp, 1) 37 | Select Case char 38 | Case """" 39 | in_string = Not in_string 40 | Case ":" 41 | If Not in_escape Then 42 | currentkey = Left(line, i_tmp - 1) 43 | currentvalue = Mid(line, i_tmp + 1) 44 | Exit For 45 | End If 46 | Case "\" 47 | in_escape = True 48 | End Select 49 | End If 50 | Next 51 | currentkey = Strip(JSONDecode(currentkey), """") 52 | If Not level(currentlevel).exists(currentkey) Then level(currentlevel).Add currentkey, "" 53 | End If 54 | If Instr(line,"{") > 0 Or Instr(line,"[") > 0 Then 55 | If Len(currentkey) = 0 Then currentkey = level(currentlevel).Count 56 | Set level(currentlevel).Item(currentkey) = Collection() 57 | Set level(currentlevel + 1) = level(currentlevel).Item(currentkey) 58 | currentlevel = currentlevel + 1 59 | currentkey = "" 60 | ElseIf Instr(line,"}") > 0 Or Instr(line,"]") > 0 Then 61 | currentlevel = currentlevel - 1 62 | ElseIf Len(Trim(line)) > 0 Then 63 | if Len(currentvalue) = 0 Then currentvalue = getJSONValue(line) 64 | currentvalue = getJSONValue(currentvalue) 65 | 66 | If Len(currentkey) = 0 Then currentkey = level(currentlevel).Count 67 | level(currentlevel).Item(currentkey) = currentvalue 68 | End If 69 | Next 70 | End Function 71 | 72 | Public Function Collection() 73 | set Collection = Server.CreateObject("Scripting.Dictionary") 74 | End Function 75 | 76 | Public Function AddToCollection(dictobj) 77 | if TypeName(dictobj) <> "Dictionary" then Err.Raise 1, "AddToCollection Error", "Not a collection." 78 | newlabel = dictobj.Count 79 | dictobj.Add newlabel, Collection() 80 | set AddToCollection = dictobj.item(newlabel) 81 | end function 82 | 83 | Private Function CleanUpJSONstring(originalstring) 84 | originalstring = Replace(originalstring,vbCrLf, "") 85 | 86 | p_datatype = Left(originalstring, 1) & Right(originalstring, 1) 87 | originalstring = Mid(originalstring, 2, Len(originalstring) - 2) 88 | in_string = False : in_escape = False 89 | For i_tmp = 1 To Len(originalstring) 90 | If in_escape Then 91 | in_escape = False 92 | Else 93 | char_tmp = Mid(originalstring, i_tmp, 1) 94 | Select Case char_tmp 95 | Case "\" : in_escape = True 96 | Case """" : s_tmp = s_tmp & char_tmp : in_string = Not in_string 97 | Case "{", "[" 98 | s_tmp = s_tmp & char_tmp & InlineIf(in_string, "", vbCrLf) 99 | Case "}", "]" 100 | s_tmp = s_tmp & InlineIf(in_string, "", vbCrLf) & char_tmp 101 | Case "," : s_tmp = s_tmp & char_tmp & InlineIf(in_string, "", vbCrLf) 102 | Case Else : s_tmp = s_tmp & char_tmp 103 | End Select 104 | End If 105 | Next 106 | 107 | CleanUpJSONstring = "" 108 | s_tmp = split(s_tmp, vbCrLf) 109 | For Each line_tmp In s_tmp 110 | CleanUpJSONstring = CleanUpJSONstring & Trim(line_tmp) & vbCrLf 111 | Next 112 | End Function 113 | 114 | Private Function getJSONValue(ByVal val) 115 | val = Trim(val) 116 | If Left(val,1) = ":" Then val = Mid(val, 2) 117 | If Right(val,1) = "," Then val = Left(val, Len(val) - 1) 118 | val = Trim(val) 119 | 120 | Select Case val 121 | Case "true" : getJSONValue = True 122 | Case "false" : getJSONValue = False 123 | Case "null" : getJSONValue = Null 124 | Case Else 125 | If (Instr(val, """") = 0) Then 126 | If IsNumeric(val) Then 127 | getJSONValue = CDbl(val) 128 | Else 129 | getJSONValue = val 130 | End If 131 | Else 132 | If Left(val,1) = """" Then val = Mid(val, 2) 133 | If Right(val,1) = """" Then val = Left(val, Len(val) - 1) 134 | getJSONValue = JSONDecode(Trim(val)) 135 | End If 136 | End Select 137 | End Function 138 | 139 | Private JSONoutput_level 140 | Public Function JSONoutput() 141 | JSONoutput_level = 1 142 | JSONoutput = Left(p_datatype, 1) & vbCrLf & GetDict(data) & Right(p_datatype, 1) 143 | End Function 144 | 145 | Private Function GetDict(objDict) 146 | For Each item In objDict 147 | Select Case TypeName(objDict.Item(item)) 148 | Case "Dictionary" 149 | GetDict = GetDict & Space(JSONoutput_level * 4) 150 | 151 | dicttype = "[]" 152 | For Each label In objDict.Item(item).Keys 153 | If Not IsInt(label) Then dicttype = "{}" 154 | Next 155 | 156 | If IsInt(item) Then 157 | GetDict = GetDict & Left(dicttype,1) & vbCrLf 158 | Else 159 | GetDict = GetDict & """" & JSONEncode(item) & """" & ": " & Left(dicttype,1) & vbCrLf 160 | End If 161 | JSONoutput_level = JSONoutput_level + 1 162 | 163 | keyvals = objDict.Keys 164 | GetDict = GetDict & GetSubDict(objDict.Item(item)) & Space(JSONoutput_level * 4) & Right(dicttype,1) & InlineIf(item = keyvals(objDict.Count - 1),"" , ",") & vbCrLf 165 | Case Else 166 | keyvals = objDict.Keys 167 | GetDict = GetDict & Space(JSONoutput_level * 4) & InlineIf(IsInt(item), "", """" & JSONEncode(item) & """: ") & WriteValue(objDict.Item(item)) & InlineIf(item = keyvals(objDict.Count - 1),"" , ",") & vbCrLf 168 | End Select 169 | Next 170 | End Function 171 | 172 | Private Function IsInt(val) 173 | IsInt = (TypeName(val) = "Integer" Or TypeName(val) = "Long") 174 | End Function 175 | 176 | Private Function GetSubDict(objSubDict) 177 | GetSubDict = GetDict(objSubDict) 178 | JSONoutput_level= JSONoutput_level -1 179 | End Function 180 | 181 | Private Function WriteValue(ByVal val) 182 | Select Case TypeName(val) 183 | Case "Double", "Integer", "Long": WriteValue = val 184 | Case "Null" : WriteValue = "null" 185 | Case "Boolean" : WriteValue = InlineIf(val, "true", "false") 186 | Case Else : WriteValue = """" & JSONEncode(val) & """" 187 | End Select 188 | End Function 189 | 190 | Private Function JSONEncode(ByVal val) 191 | val = Replace(val, "\", "\\") 192 | val = Replace(val, """", "\""") 193 | 'val = Replace(val, "/", "\/") 194 | val = Replace(val, Chr(8), "\b") 195 | val = Replace(val, Chr(12), "\f") 196 | val = Replace(val, Chr(10), "\n") 197 | val = Replace(val, Chr(13), "\r") 198 | val = Replace(val, Chr(9), "\t") 199 | JSONEncode = Trim(val) 200 | End Function 201 | 202 | Private Function JSONDecode(ByVal val) 203 | val = Replace(val, "\""", """") 204 | val = Replace(val, "\\", "\") 205 | val = Replace(val, "\/", "/") 206 | val = Replace(val, "\b", Chr(8)) 207 | val = Replace(val, "\f", Chr(12)) 208 | val = Replace(val, "\n", Chr(10)) 209 | val = Replace(val, "\r", Chr(13)) 210 | val = Replace(val, "\t", Chr(9)) 211 | JSONDecode = Trim(val) 212 | End Function 213 | 214 | Private Function InlineIf(condition, returntrue, returnfalse) 215 | If condition Then InlineIf = returntrue Else InlineIf = returnfalse 216 | End Function 217 | 218 | Private Function Strip(ByVal val, stripper) 219 | If Left(val, 1) = stripper Then val = Mid(val, 2) 220 | If Right(val, 1) = stripper Then val = Left(val, Len(val) - 1) 221 | Strip = val 222 | End Function 223 | End Class 224 | %> 225 | -------------------------------------------------------------------------------- /external/base64.asp: -------------------------------------------------------------------------------- 1 | <% 2 | Function Base64Encode(inData) 3 | 'rfc1521 4 | '2001 Antonin Foller, Motobit Software, http://Motobit.cz 5 | 'http://www.motobit.com/tips/detpg_Base64Encode/ 6 | 7 | Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 8 | Dim cOut, sOut, I 9 | 10 | 'For each group of 3 bytes 11 | 12 | For I = 1 To Len(inData) Step 3 13 | Dim nGroup, pOut, sGroup 14 | 15 | 'Create one long from this 3 bytes. 16 | 17 | nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _ 18 | &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1)) 19 | 20 | 'Oct splits the long To 8 groups with 3 bits 21 | 22 | nGroup = Oct(nGroup) 23 | 24 | 'Add leading zeros 25 | 26 | nGroup = String(8 - Len(nGroup), "0") & nGroup 27 | 28 | 'Convert To base64 29 | 30 | pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _ 31 | Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _ 32 | Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _ 33 | Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1) 34 | 35 | 'Add the part To OutPut string 36 | 37 | sOut = sOut + pOut 38 | 39 | 'Add a new line For Each 76 chars In dest (76*3/4 = 57) 40 | 'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf 41 | 42 | Next 43 | Select Case Len(inData) Mod 3 44 | Case 1: '8 bit final 45 | 46 | sOut = Left(sOut, Len(sOut) - 2) + "==" 47 | Case 2: '16 bit final 48 | 49 | sOut = Left(sOut, Len(sOut) - 1) + "=" 50 | End Select 51 | Base64Encode = sOut 52 | End Function 53 | 54 | Function MyASC(OneChar) 55 | If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar) 56 | End Function 57 | 58 | 59 | 60 | Function Base64Decode(ByVal base64String) 61 | 'rfc1521 62 | '1999 Antonin Foller, Motobit Software, http://Motobit.cz 63 | 64 | Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 65 | Dim dataLength, sOut, groupBegin 66 | 67 | 'remove white spaces, If any 68 | 69 | base64String = Replace(base64String, vbCrLf, "") 70 | base64String = Replace(base64String, vbTab, "") 71 | base64String = Replace(base64String, " ", "") 72 | 73 | 'The source must consists from groups with Len of 4 chars 74 | 75 | dataLength = Len(base64String) 76 | If dataLength Mod 4 <> 0 Then 77 | Err.Raise 1, "Base64Decode", "Bad Base64 string." 78 | Exit Function 79 | End If 80 | 81 | 82 | ' Now decode each group: 83 | 84 | For groupBegin = 1 To dataLength Step 4 85 | Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut 86 | ' Each data group encodes up To 3 actual bytes. 87 | 88 | numDataBytes = 3 89 | nGroup = 0 90 | 91 | For CharCounter = 0 To 3 92 | ' Convert each character into 6 bits of data, And add it To 93 | ' an integer For temporary storage. If a character is a '=', there 94 | ' is one fewer data byte. (There can only be a maximum of 2 '=' In 95 | ' the whole string.) 96 | 97 | thisChar = Mid(base64String, groupBegin + CharCounter, 1) 98 | 99 | If thisChar = "=" Then 100 | numDataBytes = numDataBytes - 1 101 | thisData = 0 102 | Else 103 | thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1 104 | End If 105 | If thisData = -1 Then 106 | Err.Raise 2, "Base64Decode", "Bad character In Base64 string." 107 | Exit Function 108 | End If 109 | 110 | nGroup = 64 * nGroup + thisData 111 | Next 112 | 113 | 'Hex splits the long To 6 groups with 4 bits 114 | 115 | nGroup = Hex(nGroup) 116 | 117 | 'Add leading zeros 118 | 119 | nGroup = String(6 - Len(nGroup), "0") & nGroup 120 | 121 | 'Convert the 3 byte hex integer (6 chars) To 3 characters 122 | 123 | pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _ 124 | Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _ 125 | Chr(CByte("&H" & Mid(nGroup, 5, 2))) 126 | 127 | 'add numDataBytes characters To out string 128 | 129 | sOut = sOut & Left(pOut, numDataBytes) 130 | Next 131 | 132 | 133 | 134 | Base64Decode = sOut 135 | End Function 136 | %> 137 | -------------------------------------------------------------------------------- /external/sha256.wsc: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 376 | 377 | -------------------------------------------------------------------------------- /jwt.asp: -------------------------------------------------------------------------------- 1 | 2 | <% 3 | ' Accepts an ASP dictionary of key/value pairs and a secret and 4 | ' returns a signed JSON Web Token 5 | Function JWTEncode(dPayload, sSecret) 6 | Dim sPayload, sHeader, sBase64Payload, sBase64Header 7 | Dim sSignature, sToken 8 | 9 | sPayload = DictionaryToJSONString(dPayload) 10 | sHeader = JWTHeaderDictionary() 11 | 12 | sBase64Payload = SafeBase64Encode(sPayload) 13 | sBase64Header = SafeBase64Encode(sHeader) 14 | 15 | sPayload = sBase64Header & "." & sBase64Payload 16 | sSignature = SHA256SignAndEncode(sPayload, sSecret) 17 | sToken = sPayload & "." & sSignature 18 | 19 | JWTEncode = sToken 20 | End Function 21 | 22 | ' SHA256 HMAC 23 | Function SHA256SignAndEncode(sIn, sKey) 24 | Dim sSignature 25 | 26 | 'Open WSC object to access the encryption function 27 | Set sha256 = GetObject("script:"&Server.MapPath("./external/sha256.wsc")) 28 | 29 | 'SHA256 sign data 30 | sSignature = sha256.b64_hmac_sha256(sKey, sIn) 31 | sSignature = Base64ToSafeBase64(sSignature) 32 | 33 | SHA256SignAndEncode = sSignature 34 | End Function 35 | 36 | ' Returns a static JWT header dictionary 37 | Function JWTHeaderDictionary() 38 | Dim dOut 39 | Set dOut = Server.CreateObject("Scripting.Dictionary") 40 | dOut.Add "typ", "JWT" 41 | dOut.Add "alg", "HS256" 42 | 43 | JWTHeaderDictionary = DictionaryToJSONString(dOut) 44 | End Function 45 | %> 46 | -------------------------------------------------------------------------------- /utils.asp: -------------------------------------------------------------------------------- 1 | 2 | 3 | <% 4 | ' The URL- and filename-safe Base64 encoding described in RFC 4648 [RFC4648], Section 5, 5 | ' with the (non URL-safe) '=' padding characters omitted, as permitted by Section 3.2. 6 | ' (See Appendix C of [JWS] for notes on implementing base64url encoding without padding.) 7 | ' http://tools.ietf.org/html/rfc4648 8 | ' http://tools.ietf.org/html/draft-ietf-jose-json-web-signature-10 9 | Function SafeBase64Encode(sIn) 10 | sOut = Base64Encode(sIn) 11 | sOut = Base64ToSafeBase64(sOut) 12 | 13 | SafeBase64Encode = sOut 14 | End Function 15 | 16 | ' Strips unsafe characters from a Base64 encoded string 17 | Function Base64ToSafeBase64(sIn) 18 | sOut = Replace(sIn,"+","-") 19 | sOut = Replace(sOut,"/","_") 20 | sOut = Replace(sOut,"\r","") 21 | sOut = Replace(sOut,"\n","") 22 | sOut = Replace(sOut,"=","") 23 | 24 | Base64ToSafeBase64 = sOut 25 | End Function 26 | 27 | ' Converts an ASP dictionary to a JSON string 28 | Function DictionaryToJSONString(dDictionary) 29 | Set oJSONpayload = New aspJSON 30 | 31 | 32 | Dim i, aKeys 33 | aKeys = dDictionary.keys 34 | 35 | For i = 0 to dDictionary.Count-1 36 | oJSONpayload.data (aKeys(i))= dDictionary(aKeys(i)) 37 | Next 38 | 39 | DictionaryToJSONString = oJSONpayload.JSONoutput() 40 | End Function 41 | 42 | Function dtmAdjusted_date() 43 | Dim dtmDateValue, dtmAdjusted 44 | Dim objShell, lngBiasKey, lngBias, k 45 | 46 | dtmDateValue = Now() 47 | 48 | ' Obtain local Time Zone bias from machine registry. 49 | Set objShell = CreateObject("Wscript.Shell") 50 | lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _ 51 | & "TimeZoneInformation\ActiveTimeBias") 52 | If (UCase(TypeName(lngBiasKey)) = "LONG") Then 53 | lngBias = lngBiasKey 54 | ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then 55 | lngBias = 0 56 | For k = 0 To UBound(lngBiasKey) 57 | lngBias = lngBias + (lngBiasKey(k) * 256^k) 58 | Next 59 | End If 60 | 61 | ' Convert datetime value to UTC. 62 | dtmAdjusted = DateAdd("n", lngBias, dtmDateValue) 63 | dtmAdjusted_date = dtmAdjusted 64 | 65 | End Function 66 | 67 | 68 | ' Returns the number of seconds since epoch 69 | Function SecsSinceEpoch() 70 | SecsSinceEpoch = DateDiff("s", "01/01/1970 00:00:00", dtmAdjusted_date()) 71 | End Function 72 | 73 | ' Returns a random string to prevent replays 74 | Function UniqueString() 75 | Set TypeLib = CreateObject("Scriptlet.TypeLib") 76 | UniqueString = Left(CStr(TypeLib.Guid), 38) 77 | Set TypeLib = Nothing 78 | End Function 79 | 80 | 81 | %> 82 | --------------------------------------------------------------------------------