Upgrades

We received this strange advertisement via pneumatic tube, and it claims to be able to do amazing things! But we there’s suspect something strange in it, can you uncover the truth?

Category: reversing

Solver: rgw, 3mbo

Flag: HTB{33zy_VBA_M4CR0_3nC0d1NG}

Writeup

For this challenge, we can download a zip file. When unpacking it, we see a single file Upgrades.pptm. When opening the presentation in LibreOffice, we immediately find that it contains macros:

There is one macro with the following source code:

Attribute VBA_ModuleType=VBAModule
Sub Module1
	Private Function q(g) As String
		q = ""
		For Each I In g
			q = q & Chr((I * 59 - 54) And 255)
			Next I
	End Function

	Sub OnSlideShowPageChange()
		j = Array(q(Array(245, 46, 46, 162, 245, 162, 254, 250, 33, 185, 33)), _
		q(Array(215, 120, 237, 94, 33, 162, 241, 107, 33, 20, 81, 198, 162, 219, 159, 172, 94, 33, 172, 94)), _
		q(Array(245, 46, 46, 162, 89, 159, 120, 33, 162, 254, 63, 206, 63)), _
		q(Array(89, 159, 120, 33, 162, 11, 198, 237, 46, 33, 107)), _
		q(Array(232, 33, 94, 94, 33, 120, 162, 254, 237, 94, 198, 33)))
		g = Int((UBound(j) + 1) * Rnd)
		With ActivePresentation.Slides(2).Shapes(2).TextFrame
			.TextRange.Text = j(g)
		End With
		If StrComp(Environ$(q(Array(81, 107, 33, 120, 172, 85, 185, 33))), q(Array(154, 254, 232, 3, 171, 171, 16, 29, 111, 228, 232, 245, 111, 89, 158, 219, 24, 210, 111, 171, 172, 219, 210, 46, 197, 76, 167, 233)), vbBinaryCompare) = 0 Then
			VBA.CreateObject(q(Array(215, 11, 59, 120, 237, 146, 94, 236, 11, 250, 33, 198, 198))).Run (q(Array(59, 185, 46, 236, 33, 42, 33, 162, 223, 219, 162, 107, 250, 81, 94, 46, 159, 55, 172, 162, 223, 11)))
		End If
	End Sub
End Sub

We see that the macro defines one function, q(g) that takes an array and outputs a string. As the logic is not that complicated, we can code up a python equivalent:

def q(arr):
    return "".join(chr((i*59-54)&255) for i in arr)

Next, we put in all arrays in calls to q into this function and look at the generated strings. The first five arrays do not contain anything useful, but the following block looks promising:

If StrComp(Environ$(q(Array(81, 107, 33, 120, 172, 85, 185, 33))), q(Array(154, 254, 232, 3, 171, 171, 16, 29, 111, 228, 232, 245, 111, 89, 158, 219, 24, 210, 111, 171, 172, 219, 210, 46, 197, 76, 167, 233)), vbBinaryCompare) = 0 Then
	VBA.CreateObject(q(Array(215, 11, 59, 120, 237, 146, 94, 236, 11, 250, 33, 198, 198))).Run (q(Array(59, 185, 46, 236, 33, 42, 33, 162, 223, 219, 162, 107, 250, 81, 94, 46, 159, 55, 172, 162, 223, 11)))
End If

Decoding the arrays with our new function, we get:

If StrComp(Environ$("username"), "HTB{33zy_VBA_M4CR0_3nC0d1NG}"), vbBinaryCompare) = 0 Then
	VBA.CreateObject("WScript.Shell").Run("cmd.exe /C shutdown /S")
End If

We immediately see the flag HTB{33zy_VBA_M4CR0_3nC0d1NG}.

Writeup#

Writeup