OAuth authentication

[trixmoto]

I have been working on a project recently that required me to create OAuth headers. It wasn't a full implementation of OAuth, as the Token and Token Secret were both excluded, but I spent so much time on the code, I thought I'd share it anyway

Code: Select all

Dim ConsumerKey : ConsumerKey = "this is the consumer key"
Dim ConsumerSecret : ConsumerSecret = "this is the consumer secret"

Dim OAuthHeader : OAuthHeader = GetOAuth("GET","http://www.google.com")

Function GetOAuth(Method,FullPath)
  Dim non : non = GetNonce()
  Dim tms : tms = GetTimestamp()
  GetOAuth = "Authorization: OAuth oauth_signature_method=""HMAC-SHA1"", oauth_version=""1.0"
  GetOAuth = GetOAuth&""", oauth_consumer_key="""&URLEncode(ConsumerKey)
  GetOAuth = GetOAuth&""", oauth_timestamp="""&URLEncode(tms)&""", oauth_nonce="""&URLEncode(non)
  GetOAuth = GetOAuth&""", oauth_signature="""&URLEncode(GetSignature(Method,FullPath,non,tms))&""""
End Function

Function GetNonce()
  Dim TypeLib : Set TypeLib = CreateObject("Scriptlet.TypeLib")
  GetNonce = Left(Base64Encode(Mid(TypeLib.Guid,2,32)),16)
End Function

Function GetTimestamp()
  GetTimestamp = DateDiff("s","1/1/1970 12:00:00 AM",Now())
End Function

Function GetSignature(Method,FullPath,Nonce,Timestamp)
  Dim path : path = FullPath
  Dim pars : pars = ""
  Dim temp : temp = InStr(FullPath,"?")
  If temp > 0 Then
    path = Left(FullPath,temp-1)
    pars = Mid(FullPath,temp+1)&"&"  '<--- this is a hack because the query string parameters need to be alphabetically (only "code" in my case)
  End If  
  pars = pars&"oauth_consumer_key="&URLEncode(ConsumerKey)
  pars = pars&"&oauth_nonce="&URLEncode(Nonce)&"&oauth_signature_method=HMAC-SHA1&oauth_timestamp="&Timestamp&"&oauth_version=1.0"
  Dim text : text = UCase(Method)&"&"&URLEncode(path)&"&"&URLEncode(pars)
  Dim keys : keys = URLEncode(ConsumerSecret)&"&"  '<--- the Token Secret would be appended here
  GetSignature = Base64_HMACSHA1(text,keys)
End Function

Function URLEncode(str)
  Dim intPos,intASCII
  Dim strTemp : strTemp = ""
  Dim strChar : strChar = ""
  For intPos = 1 To Len(str)
    intASCII = Asc(Mid(str,intPos,1))
    If intASCII = 32 Then
      strTemp = strTemp&"+"
    ElseIf intASCII = 45 Then
      strTemp = strTemp&"-"
    ElseIf intASCII = 46 Then
      strTemp = strTemp&"."
    ElseIf intASCII = 95 Then
      strTemp = strTemp&"_"
    ElseIf intASCII = 126 Then
      strTemp = strTemp&"~"      
    ElseIf ((intASCII < 123) And (intASCII > 96)) Then
      strTemp = strTemp&Chr(intASCII)
    ElseIf ((intASCII < 91) And (intASCII > 64)) Then
      strTemp = strTemp&Chr(intASCII)
    ElseIf ((intASCII < 58) And (intASCII > 47)) Then
      strTemp = strTemp&Chr(intASCII)
    Else
      strChar = UCase(Trim(Hex(intASCII)))
      If intASCII < 16 Then
        strTemp = strTemp&"%0"&strChar
      Else
        strTemp = strTemp&"%"&strChar
      End If
    End If
  Next
  URLEncode = strTemp
End Function

Function Base64_HMACSHA1(sTextToHash,sSharedSecretKey)
  Dim asc : Set asc = CreateObject("System.Text.UTF8Encoding")
  Dim enc : Set enc = CreateObject("System.Security.Cryptography.HMACSHA1")
  Dim txt : txt = asc.Getbytes_4(sTextToHash)
  enc.Key = asc.Getbytes_4(sSharedSecretKey)
  Dim xml : Set xml = CreateObject("MSXML2.DOMDocument")
  Dim obj : Set obj = xml.createElement("b64")
  obj.DataType = "bin.base64"
  obj.nodeTypedValue = enc.ComputeHash_2((txt))
  Base64_HMACSHA1 = obj.Text
End Function

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

You may notice that some of the code at the bottom is not my own, and that there are two different methods for Base64 encoding data, but it works all the same. The important bit for me was the creation of the signature, which took some time to figure out and get right.

When creating the signature, the parameters need to be in alphabetical order (see RFC 5849 for details). However, because I knew that my only query string parameter was "code" I just stick this at the beginning of the string. If you're dealing with unknown or varied query string parameters, you may need to build a dictionary or something so that they can be sorted.

It's obviously impossible to keep the Consumer Secret a secret in a scripting language like VBScript. In my case I obfuscated it using a string rotation method, so the value in the script was passed into the opposite function to use it. Anyone can easily use this method to get the plaintext value themselves, so it's not secret, but the client was happy that it was obfuscated only - worth thinking about though!

[Peke]

nice.