Classic ASP amazon s3 rest authorisation

Question

I am confused on what I am doing wrong here...

Answer 1

Thank you so much for this question, it has been such a great help to start my WSH/VBScript for my S3 backup service ;-)

I do not have much time, so I will not go through the details of the things I have changed from Chris' code, but please find below my little prototype script which works perfectly ;-)

This is just a WSH/VBScript, so you do not need IIS to run it, you just need to paste the content in a file with the ".vbs" extension, and you can then directly execute it ;-)

Option Explicit
'-- Amazon Web Services > My Account > Access Credentials > Access Keys --'
Dim strAccessKeyID: strAccessKeyID = "..."
Dim strSecretAccessKey: strSecretAccessKey = "..."
'-- Parameters: --'
Dim strLocalFile: strLocalFile = "..."
Dim strRemoteFile: strRemoteFile = "..."
Dim strBucket: strBucket = "..."
'-- Authentication: --'
Dim strNowInGMT: strNowInGMT = NowInGMT()
Dim strStringToSign: strStringToSign = _
  "PUT" & vbLf & _
  "" & vbLf & _
  "text/xml" & vbLf & _
  strNowInGMT & vbLf & _
  "/" & strBucket + "/" & strRemoteFile
Dim strSignature: strSignature = ConvertBytesToBase64(HMACSHA1(strSecretAccessKey, strStringToSign))
Dim strAuthorization: strAuthorization = "AWS " & strAccessKeyID & ":" & strSignature
'-- Upload: --'
Dim xhttp: Set xhttp = CreateObject("MSXML2.ServerXMLHTTP")
xhttp.open "PUT", "http://" & strBucket & ".s3.amazonaws.com/" & strRemoteFile, False
xhttp.setRequestHeader "Content-Type", "text/xml"
xhttp.setRequestHeader "Date", strNowInGMT 'Yes, this line is mandatory ;-) --'
xhttp.setRequestHeader "Authorization", strAuthorization
xhttp.send GetBytesFromFile(strLocalFile)
If xhttp.status = "200" Then
  WScript.Echo "The file has been successfully uploaded ;-)"
Else
  WScript.Echo "There was an error :-(" & vbCrLf & vbCrLf & _
  xhttp.responseText
End If
Set xhttp = Nothing
'-- NowInGMT ------------------------------------------------------------------'
Function NowInGMT()
  'This is probably not the best implementation, but it works ;-) --'
  Dim sh: Set sh = WScript.CreateObject("WScript.Shell")
  Dim iOffset: iOffset = sh.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
  Dim dtNowGMT: dtNowGMT = DateAdd("n", iOffset, Now())
  Dim strDay: strDay = "NA"
  Select Case Weekday(dtNowGMT)
    Case 1 strDay = "Sun"
    Case 2 strDay = "Mon"
    Case 3 strDay = "Tue"
    Case 4 strDay = "Wed"
    Case 5 strDay = "Thu"
    Case 6 strDay = "Fri"
    Case 7 strDay = "Sat"
    Case Else strDay = "Error"
  End Select
  Dim strMonth: strMonth = "NA"
  Select Case Month(dtNowGMT)
    Case 1 strMonth = "Jan"
    Case 2 strMonth = "Feb"
    Case 3 strMonth = "Mar"
    Case 4 strMonth = "Apr"
    Case 5 strMonth = "May"
    Case 6 strMonth = "Jun"
    Case 7 strMonth = "Jul"
    Case 8 strMonth = "Aug"
    Case 9 strMonth = "Sep"
    Case 10 strMonth = "Oct"
    Case 11 strMonth = "Nov"
    Case 12 strMonth = "Dec"
    Case Else strMonth = "Error"
  End Select
  Dim strHour: strHour = CStr(Hour(dtNowGMT))
  If Len(strHour) = 1 Then strHour = "0" & strHour End If
  Dim strMinute: strMinute = CStr(Minute(dtNowGMT))
  If Len(strMinute) = 1 Then strMinute = "0" & strMinute End If
  Dim strSecond: strSecond = CStr(Second(dtNowGMT))
  If Len(strSecond) = 1 Then strSecond = "0" & strSecond End If
  Dim strNowInGMT: strNowInGMT = _
    strDay & _
    ", " & _
    Day(dtNowGMT) & _
    " " & _
    strMonth & _
    " " & _
    Year(dtNowGMT) & _
    " " & _
    strHour & _
    ":" & _
    strMinute & _
    ":" & _
    strSecond & _
    " +0000"
  NowInGMT = strNowInGMT
End Function
'-- GetBytesFromString --------------------------------------------------------'
Function GetBytesFromString(strValue)
  Dim stm: Set stm = CreateObject("ADODB.Stream")
  stm.Open
  stm.Type = 2
  stm.Charset = "ascii"
  stm.WriteText strValue
  stm.Position = 0
  stm.Type = 1
  GetBytesFromString = stm.Read
  Set stm = Nothing
End Function
'-- HMACSHA1 ------------------------------------------------------------------'
Function HMACSHA1(strKey, strValue)
  Dim sha1: Set sha1 = CreateObject("System.Security.Cryptography.HMACSHA1")
  sha1.key = GetBytesFromString(strKey)
  HMACSHA1 = sha1.ComputeHash_2(GetBytesFromString(strValue))
  Set sha1 = Nothing
End Function
'-- ConvertBytesToBase64 ------------------------------------------------------'
Function ConvertBytesToBase64(byteValue)
  Dim dom: Set dom = CreateObject("MSXML2.DomDocument")
  Dim elm: Set elm = dom.CreateElement("b64")
  elm.dataType = "bin.base64"
  elm.nodeTypedValue = byteValue
  ConvertBytesToBase64 = elm.Text
  Set elm = Nothing
  Set dom = Nothing
End Function
'-- GetBytesFromFile ----------------------------------------------------------'
Function GetBytesFromFile(strFileName)
  Dim stm: Set stm = CreateObject("ADODB.Stream")
  stm.Type = 1 'adTypeBinary --'
  stm.Open
  stm.LoadFromFile strFileName
  stm.Position = 0
  GetBytesFromFile = stm.Read
  stm.Close
  Set stm = Nothing
End Function

Dear stone-edge-technology-VBScript-mates (*), let me know if it is working for you as well ;-)

(*) This is a reference to the comment from Spudley, see above ;-)