3 月 16 日に Outlook のゼロデイ脆弱性となる CVE-2023-23397 が公開され、それを悪用されていないかを Exchange サーバー上で確認するためのスクリプトも同時に公開されました。
しかし、この脆弱性は Outlook を狙ったものであるため、Exchange 環境以外でも影響があります。
3/24 に Guidance for investigating attacks using CVE-2023-23397 – Microsoft Security Blog として CVE-2023-23397 で使用されるプロパティの詳細も公開されたので、こちらの情報をもとに Outlook 上で脆弱性の悪用がないかを確認するスクリプトを作成しました。
このスクリプトは、Outlook のプロファイル中にあるメールボックスや PST などに含まれるすべてのアイテムについて脆弱性に使用される PidLidReminderFileParameter というプロパティの値が存在するかを確認し、存在していた場合はそのアイテムが保存されているフォルダーのパスや件名、受信日時 (受信日時がないアイテムの場合は最終更新日時) および PidLidReminderFileParameter の値を出力します。
フォルダーのパスは PST などが保存されているパスではなく、Outlook のフォルダー ツリー上のパスになります。
各行の最後の文字列が PidLidReminderFileParameter の値となり、この値が \\ で始まる UNC だった場合、悪用されている可能性が高いといえます。
また、LOG_ROOT で \\server\share の様にネットワーク共有を指定すれば多数のユーザーの状況を一元管理できるよう、ファイル名には USERNAME 環境変数に格納されているユーザー名が使用されます。
スクリプトは以下の通りです。
このスクリプトをメモ帳などで拡張子 .vbs として保存し、ダブルクリックで実行すると c:\temp に ReminderFile-ユーザー名.log というファイル名でスキャン結果が格納されます。
'
' ログファイルが書き込まれるフォルダーとファイルのプレフィックスを指定
Const LOG_ROOT = "c:\temp\ReminderFile-"
'
Dim wshShell
Dim strLogFile
Dim objFSO
Dim stmLog
Dim appOlk
Dim oneStore
Dim fldRoot
Dim cFound
cFound = 0
' ファイル名を作成
Set wshShell = CreateObject("WScript.Shell")
strLogFile = LOG_ROOT & wshShell.ExpandEnvironmentStrings("%USERNAME%") & ".log"
' ログファイルを作成
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set stmLog = objFSO.CreateTextFile(strLogFile, True)
' Outlook Application オブジェクトのインスタンスを生成
Set appOlk = CreateObject("Outlook.Application")
' プロファイル中のすべてのストアについてログ出力
For Each oneStore In appOlk.Session.Stores
Set fldRoot = oneStore.GetRootFolder()
ListReminderFileRecurs fldRoot
Next
' 見つかったアイテムの数をログ出力
stmLog.WriteLine cFound & " 件のアイテムが見つかりました。"
' ログファイルをクローズ
stmLog.Close()
'
MsgBox "スキャンは終了しました。"
'
' 再帰的にアイテムをチェックする
Sub ListReminderFileRecurs( fldRoot )
On Error Resume Next
' 脆弱性に悪用されるプロパティの定義
Const PidLidReminderFileParameter = "http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/851F001F"
Dim objItem
Dim fldSub
' フォルダ中のすべてのアイテムについてチェック
For Each objItem In fldRoot.Items
Dim strFile
Dim strReceived
strFile = ""
' プロパティの値を取得
strFile = objItem.PropertyAccessor.GetProperty(PidLidReminderFileParameter)
' プロパティに値が設定されていたらログ出力
If strFile <> "" Then
' 受信日時がないアイテムについては最終更新日時を取得する
strReceived = objItem.ReceivedTime
If strReceived = "" Then
strReceived = objItem.LastModificationTime
End If
' ログを出力
stmLog.WriteLine fldRoot.FolderPath & vbTab & objItem.Subject & vbTab & strReceived
' 検出アイテムのカウントを増加
cFound = cFound + 1
End If
Next
' サブ フォルダーについて再帰的に処理
For Each fldSub In fldRoot.Folders
ListReminderFileRecurs fldSub
Next
End Sub
Outlook 研究所 