Excel VBAでSSHAの生成・検証を実装してみた

動機

仕事で使うとあるシステムで、XMLに書き出した登録ユーザーの認証情報をサーバーにインポートすることがあります。
ユーザー登録リクエストのリストもExcelで受け取るし、他の同僚も使えるように、リストを元にXMLへの書き出しを行うコードをExcel VBAで書いてみました。
各ユーザーのパスワードはSSHAとしてXMLに格納されますが、パスワードからSSHAへの変換とその検証もVBAで書いてみました。本記事は、このSSHAの生成と検証を行う部分についてです。

参考にした情報

SHA1暗号化やBase64に関する部分は、下記サイトを参考にさせていただき、掲載されているコードを一部変更して利用させていただいています。

• SHA1暗号化について
  • WSHのVBScriptでsha1ハッシュを生成するサンプル（DLL不要)
  • こちらのコードを利用するには.NET Frameworkが必要です。
• Base64エンコーディング、デコーディングについて
  • 【参照設定不要】Base64フォーマットにエンコードする

SSHAの部分は随分前に書いていたRubyスクリプトをベースにしました。それもどこかのサイトの情報を元に書いたはずですが、参考にさせていただいたサイトを失念してしまいました。

今回のコードではソルトのバイト長(SaltLength)を8バイト固定としていますが、これは今回対象としたシステムの仕様に従っています。またSSHA生成時にランダムに生成するソルトはSaltCharsに含まれるASCII文字列のみですが、今回対象としたシステムによって生成されるSSHAは非ASCIIのバイト列からなるソルトも利用されており、このようなSSHAの検証にも対応しているつもりです。

使い方

• sshaString = ssha(aStrIn, aSalt) … SSHAを生成します。

  • 引数 aStrIn (必須): SSHA生成の元となる文字列またはパスワード。
  • 引数 aSalt (省略可): SSHA生成時のソルト。省略時はランダムに生成。
    • バイト配列をカンマ区切りの16進数文字列として指定します。 (例： "53,4E,39,59,4D,42,53,66,")
  • 戻り値 sshaString: SSHA文字列。(例： {SSHA}JFKGJJxxHO5KAGt/NmYOdi6PTxhvN3N4UkM5MQ==)

• isValid = isValidPassword(aSSHA, aPasswd) … 指定されたSSHAとパスワードのペアがマッチするかを検証します。

  • 引数 aSSHA (必須): 検証に使用するSSHA文字列。
  • 引数 aPasswd (必須): 検証に使用するパスワード文字列。
  • 戻り値 isValid: 検証結果をBoolean値で返します。(True: マッチした、False: マッチしなかった)

動作環境

Windows 10 Enterprise (Version 20H2, OS Build 19042.1052)
Microsoft Excel for Microsoft 365 MSO (16.0.13127.21656) 32-bit

ハマったところ、改善点？

当初、関数ssha()に第2引数aSaltをbyte arrayとして渡そうとしていたのですが、ByValで渡すと途中でUTF-16に変換されるのか(?)期待通りに値を渡せませんでした。ByRefにすると引数省略時の値(Nothing)の設定が上手くいかなかったりしました(詳細忘れかけてます)。
結局、バイト配列を一旦、カンマ区切りの16進数文字列に変換して渡すようにしたのが現在の実装です。もっとスマートな方法があれば教えていただけると嬉しいです。

最後に

SSHAの仕様や参考にさせていただいたコードについても、あまり詳細まで確認できておりません。もしかしたら勘違いや間違った使い方をしているかも知れません。お気づきの点があればご指摘いただければ幸いです。

ssha.bas

Const SaltLength = 8
Const SaltChars = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

Function ssha(ByVal aStrIn As String, Optional ByVal aSalt As String = "") As String

   Dim sha1 As Object, b64 As Object, enc As Object
   Dim bytes() As Byte, hash() As Byte
   Dim salt(SaltLength-1) As Byte, i As Integer, max As Integer, saltHex As Variant
  ' Prepare objects
   Set b64 = CreateObject("Msxml2.DOMDocument.3.0").createElement("base64")
   Set enc = CreateObject("System.Text.UTF8Encoding")

   ' Prepare "salt" for SSHA
   If Len(aSalt) = 0 Then ' It was not specified
      max = Len(SaltChars)
      For i = 0 To SaltLength-1
         Randomize
         salt(i) = enc.GetBytes_4(Mid(SaltChars, Int(max * Rnd + 1), 1))(0) ' as UTF-8
      Next i
   Else
      saltHex = Split(aSalt, ",")
      For i = 0 To SaltLength-1
         salt(i) = Val("&H" & saltHex(i))
      Next i
   End If

   ' Convert the string into byte array and catenate it with salt
   bytes = CStr(enc.GetBytes_4(aStrIn)) & CStr(salt)

   ' Compute the SHA1 hash with salt
   Set sha1 = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
   sha1.ComputeHash_2(bytes)
   hash = CStr(sha1.Hash) & CStr(salt) ' concatenate byte arrays (hash + salt)

  ' Base64 Encoding
  b64.DataType = "bin.base64"
  b64.nodeTypedValue = hash

  ssha = "{SSHA}" & Replace(b64.Text, vbLf, "") ' Replace() seems not necessary, though
End Function

Function isValidPassword(ByVal aSSHA As String, ByVal aPasswd As String) As Boolean
   Dim b64 As Object, enc As Object, bytes() As Byte, salt As String, i As Integer

   ' Prepare objects
   Set b64 = CreateObject("Msxml2.DOMDocument.3.0").createElement("base64")
   Set enc = CreateObject("System.Text.UTF8Encoding")
   ' Base64 Decoding
   b64.DataType = "bin.base64"
   b64.Text = Replace(aSSHA, "{SSHA}", "", count:=1)

   ' Extract the salt from SSHA phrase
   bytes = b64.nodeTypedValue
   salt = ""
   For i = UBound(bytes) - SaltLength + 1 To UBound(bytes) ' Extract last SaltLength bytes
      salt = salt & Hex(bytes(i)) & "," ' the last "," will be ignored
   Next i
   ' Check if the password is valid or not
   If ssha(aPasswd, salt) = aSSHA Then ' pass salt as hex strings separated by ",".
      isValidPassword = True
   Else
      isValidPassword = False
   End If
End Function