Encoding a Feeligo Community Api User Token with Classic ASP

README.md

Encoding a Feeligo Community Api User Token with Classic ASP

Uses the following code:

• aspjson for JSON encoding/decoding

• Base64 encoding/decoding functions, with custom functions for URL-safe operations

See the _encoding.asp file below for implementation

Sample output

from executing _encoding.asp:

The TokenData Object is:

 {"user_id":"USER_ID","api_key":"YOUR_API_KEY"}

The TokenAuth Object is:

 {"s":"abcdefghijklmno123456789","t":1352927900}

The Token Object is:

 {"data":{"user_id":"USER_ID","api_key":"YOUR_API_KEY"},"auth":{"s":"abcdefghijklmno123456789","t":1352927900}}

The Token string is:

 eyJkYXRhIjp7InVzZXJfaWQiOiJVU0VSX0lEIiwiYXBpX2tleSI6IllPVVJfQVBJX0tFWSJ9LCJhdXRoIjp7InMiOiJhYmNkZWZnaGlqa2xtbm8xMjM0NTY3ODkiLCJ0IjoxMzUyOTI3OTAwfX0=

_encoding.asp

<!--loads the JSON encoding library (from http://code.google.com/p/aspjson/) -->
<!--#include file="JSON_2.0.4.asp"-->

<!-- loads the Base64 encoding library (from http://nolovelust.com/post/classic-asp-base64-encoder-decoder.aspx) -->
<!--#include file="base64.asp"-->


<%
'1. Build the TokenData object
'-----------------------------
'We use the jsObject class provided by the JSON library, which
'behaves as an associative array.
Dim tokenDataObject
Set tokenDataObject = jsObject()
tokenDataObject("user_id") = "USER_ID"
tokenDataObject("api_key") = "YOUR_API_KEY"
' you can add other fields such as `payload`... 
%>

The TokenData Object is:<br/>
<pre><%= tokenDataObject.jsString() %></pre>

<%
'2. Generate a signature from the TokenData object
'-------------------------------------------------
'Here we assume you can generate a signature for the TokenData.
'This involves generating a DataString from the tokenDataObject,
'combining it with the secret key and timestamp and hash with Sha-1
Dim timestamp
timestamp = DateDiff("s", "01/01/1970 00:00:00", Now())
Dim tokenSignature
tokenSignature = "abcdefghijklmno123456789"


'3. Build the TokenAuth object
'-------------------------------------------------
'The TokenAuth object contains the token signature and the timestamp
'used to generate it.
Dim tokenAuthObject
Set tokenAuthObject = jsObject()
tokenAuthObject("s") = tokenSignature
tokenAuthObject("t") = timestamp
%>

The TokenAuth Object is:<br/>
<pre><%= tokenAuthObject.jsString() %></pre>

<%
'4. Build the Token Object
'-------------------------------------------------
'The Token object is simply obtained by combining the Data and Auth
'objects into a new associative array.

Dim tokenObject
Set tokenObject = jsObject()
Set tokenObject("data") = tokenDataObject
Set tokenObject("auth") = tokenAuthObject
%>

The Token Object is:<br/>
<pre><%= tokenObject.jsString() %></pre>

<%
'5. Encode the Token Object to URL-safe Base64
'---------------------------------------------
'We use the Base64UrlSafeEncode function provided by the Base64 library
'to encode the JSON string representation of the TokenObject.

Dim token_string
token_string = Base64UrlSafeEncode(tokenObject.jsString())
%>

<b>The Token string is:<br/>
<pre><%= token_string %></pre>
</b>

base64.asp

<%
'Base64UrlSafeEncode
Function Base64UrlSafeEncode(inData)
  Base64UrlSafeEncode = Replace(Replace(Base64Encode(inData), "+", "-"), "/", "_")
End Function

Function Base64UrlSafeDecode(inData)
  Base64UrlSafeDecode = Base64Decode(Replace(Replace(inData, "-", "+"), "_", "/"))
End Function


'Base64Encode and Base64Decode functions from http://nolovelust.com/post/classic-asp-base64-encoder-decoder.aspx
'
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
 
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
 
'For each group of 3 bytes
 
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
 
'Create one long from this 3 bytes.
 
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
 
'Oct splits the long To 8 groups with 3 bits
 
nGroup = Oct(nGroup)
 
'Add leading zeros
 
nGroup = String(8 - Len(nGroup), "0") & nGroup
 
'Convert To base64
 
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
 
'Add the part To OutPut string
 
sOut = sOut + pOut
 
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
 
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
 
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
 
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
 
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
 
 
 
Function Base64Decode(ByVal base64String)
'rfc1521
'1999 Antonin Foller, Motobit Software, http://Motobit.cz
 
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
 
'remove white spaces, If any
 
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
 
'The source must consists from groups with Len of 4 chars
 
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
 
 
' Now decode each group:
 
For groupBegin = 1 To dataLength Step 4
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
' Each data group encodes up To 3 actual bytes.
 
numDataBytes = 3
nGroup = 0
 
For CharCounter = 0 To 3
' Convert each character into 6 bits of data, And add it To
' an integer For temporary storage. If a character is a '=', there
' is one fewer data byte. (There can only be a maximum of 2 '=' In
' the whole string.)
 
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
 
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then
Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
Exit Function
End If
 
nGroup = 64 * nGroup + thisData
Next
 
'Hex splits the long To 6 groups with 4 bits
 
nGroup = Hex(nGroup)
 
'Add leading zeros
 
nGroup = String(6 - Len(nGroup), "0") & nGroup
 
'Convert the 3 byte hex integer (6 chars) To 3 characters
 
pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 5, 2)))
 
'add numDataBytes characters To out string
 
sOut = sOut & Left(pOut, numDataBytes)
Next
 
Base64Decode = sOut
End Function
%>

JSON_2.0.4.asp

<%
'
'	VBS JSON 2.0.3
'	Copyright (c) 2009 Tuðrul Topuz
'	Under the MIT (MIT-LICENSE.txt) license.
'

Const JSON_OBJECT	= 0
Const JSON_ARRAY	= 1

Class jsCore
	Public Collection
	Public Count
	Public QuotedVars
	Public Kind ' 0 = object, 1 = array

	Private Sub Class_Initialize
		Set Collection = CreateObject("Scripting.Dictionary")
		QuotedVars = True
		Count = 0
	End Sub

	Private Sub Class_Terminate
		Set Collection = Nothing
	End Sub

	' counter
	Private Property Get Counter 
		Counter = Count
		Count = Count + 1
	End Property

	' - data maluplation
	' -- pair
	Public Property Let Pair(p, v)
		If IsNull(p) Then p = Counter
		Collection(p) = v
	End Property

	Public Property Set Pair(p, v)
		If IsNull(p) Then p = Counter
		If TypeName(v) <> "jsCore" Then
			Err.Raise &hD, "class: class", "Incompatible types: '" & TypeName(v) & "'"
		End If
		Set Collection(p) = v
	End Property

	Public Default Property Get Pair(p)
		If IsNull(p) Then p = Count - 1
		If IsObject(Collection(p)) Then
			Set Pair = Collection(p)
		Else
			Pair = Collection(p)
		End If
	End Property
	' -- pair
	Public Sub Clean
		Collection.RemoveAll
	End Sub

	Public Sub Remove(vProp)
		Collection.Remove vProp
	End Sub
	' data maluplation

	' encoding
	Function jsEncode(str)
		Dim charmap(127), haystack()
		charmap(8)  = "\b"
		charmap(9)  = "\t"
		charmap(10) = "\n"
		charmap(12) = "\f"
		charmap(13) = "\r"
		charmap(34) = "\"""
		charmap(47) = "\/"
		charmap(92) = "\\"

		Dim strlen : strlen = Len(str) - 1
		ReDim haystack(strlen)

		Dim i, charcode
		For i = 0 To strlen
			haystack(i) = Mid(str, i + 1, 1)

			charcode = AscW(haystack(i)) And 65535
			If charcode < 127 Then
				If Not IsEmpty(charmap(charcode)) Then
					haystack(i) = charmap(charcode)
				ElseIf charcode < 32 Then
					haystack(i) = "\u" & Right("000" & Hex(charcode), 4)
				End If
			Else
				haystack(i) = "\u" & Right("000" & Hex(charcode), 4)
			End If
		Next

		jsEncode = Join(haystack, "")
	End Function

	' converting
	Public Function toJSON(vPair)
		Select Case VarType(vPair)
			Case 0	' Empty
				toJSON = "null"
			Case 1	' Null
				toJSON = "null"
			Case 7	' Date
				' toJSON = "new Date(" & (vPair - CDate(25569)) * 86400000 & ")"	' let in only utc time
				toJSON = """" & CStr(vPair) & """"
			Case 8	' String
				toJSON = """" & jsEncode(vPair) & """"
			Case 9	' Object
				Dim bFI,i 
				bFI = True
				If vPair.Kind Then toJSON = toJSON & "[" Else toJSON = toJSON & "{"
				For Each i In vPair.Collection
					If bFI Then bFI = False Else toJSON = toJSON & ","

					If vPair.Kind Then 
						toJSON = toJSON & toJSON(vPair(i))
					Else
						If QuotedVars Then
							toJSON = toJSON & """" & i & """:" & toJSON(vPair(i))
						Else
							toJSON = toJSON & i & ":" & toJSON(vPair(i))
						End If
					End If
				Next
				If vPair.Kind Then toJSON = toJSON & "]" Else toJSON = toJSON & "}"
			Case 11
				If vPair Then toJSON = "true" Else toJSON = "false"
			Case 12, 8192, 8204
				toJSON = RenderArray(vPair, 1, "")
			Case Else
				toJSON = Replace(vPair, ",", ".")
		End select
	End Function

	Function RenderArray(arr, depth, parent)
		Dim first : first = LBound(arr, depth)
		Dim last : last = UBound(arr, depth)

		Dim index, rendered
		Dim limiter : limiter = ","

		RenderArray = "["
		For index = first To last
			If index = last Then
				limiter = ""
			End If 

			On Error Resume Next
			rendered = RenderArray(arr, depth + 1, parent & index & "," )

			If Err = 9 Then
				On Error GoTo 0
				RenderArray = RenderArray & toJSON(Eval("arr(" & parent & index & ")")) & limiter
			Else
				RenderArray = RenderArray & rendered & "" & limiter
			End If
		Next
		RenderArray = RenderArray & "]"
	End Function

	Public Property Get jsString
		jsString = toJSON(Me)
	End Property

	Sub Flush
		If TypeName(Response) <> "Empty" Then 
			Response.Write(jsString)
		ElseIf WScript <> Empty Then 
			WScript.Echo(jsString)
		End If
	End Sub

	Public Function Clone
		Set Clone = ColClone(Me)
	End Function

	Private Function ColClone(core)
		Dim jsc, i
		Set jsc = new jsCore
		jsc.Kind = core.Kind
		For Each i In core.Collection
			If IsObject(core(i)) Then
				Set jsc(i) = ColClone(core(i))
			Else
				jsc(i) = core(i)
			End If
		Next
		Set ColClone = jsc
	End Function

End Class

Function jsObject
	Set jsObject = new jsCore
	jsObject.Kind = JSON_OBJECT
End Function

Function jsArray
	Set jsArray = new jsCore
	jsArray.Kind = JSON_ARRAY
End Function

Function toJSON(val)
	toJSON = (new jsCore).toJSON(val)
End Function
%>