Public Class SafariDecryptor

#Region "private APIs & structs"

        <DllImport("kernel32.dll")> _
        Private Shared Function LocalFree(ByVal hMem As IntPtr) As IntPtr
        End Function

        <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
        Private Structure DATA_BLOB
            Public cbData As Integer
            Public pbData As IntPtr
        End Structure

        <DllImport("Crypt32.dll", SetLastError:=True, CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
        Private Shared Function CryptUnprotectData _
        ( _
        ByRef pDataIn As DATA_BLOB, _
        ByVal szDataDescr As String, _
        ByRef pOptionalEntropy As DATA_BLOB, _
        ByVal pvReserved As IntPtr, _
        ByRef pPromptStruct As IntPtr, _
        ByVal dwFlags As Integer, _
        ByRef pDataOut As DATA_BLOB _
        ) As Boolean

        End Function

#End Region

        Private Shared salt As Byte() = {&H1D, &HAC, &HA8, &HF8, &HD3, &HB8, _
                                         &H48, &H3E, &H48, &H7D, &H3E, &HA, _
                                         &H62, &H7, &HDD, &H26, &HE6, &H67, _
                                         &H81, &H3, &HE7, &HB2, &H13, &HA5, _
                                         &HB0, &H79, &HEE, &H4F, &HF, &H41, _
                                         &H15, &HED, &H7B, &H14, &H8C, &HE5, _
                                         &H4B, &H46, &HD, &HC1, &H8E, &HFE, _
                                         &HD6, &HE7, &H27, &H75, &H6, &H8B, _
                                         &H49, &H0, &HDC, &HF, &H30, &HA0, _
                                         &H9E, &HFD, &H9, &H85, &HF1, &HC8, _
                                         &HAA, &H75, &HC1, &H8, &H5, &H79, _
                                         &H1, &HE2, &H97, &HD8, &HAF, &H80, _
                                         &H38, &H60, &HB, &H71, &HE, &H68, _
                                         &H53, &H77, &H2F, &HF, &H61, &HF6, _
                                         &H1D, &H8E, &H8F, &H5C, &HB2, &H3D, _
                                         &H21, &H74, &H40, &H4B, &HB5, &H6, _
                                         &H6E, &HAB, &H7A, &HBD, &H8B, &HA9, _
                                         &H7E, &H32, &H8F, &H6E, &H6, &H24, _
                                         &HD9, &H29, &HA4, &HA5, &HBE, &H26, _
                                         &H23, &HFD, &HEE, &HF1, &H4C, &HF, _
                                         &H74, &H5E, &H58, &HFB, &H91, &H74, _
                                         &HEF, &H91, &H63, &H6F, &H6D, &H2E, _
                                         &H61, &H70, &H70, &H6C, &H65, &H2E, _
                                         &H53, &H61, &H66, &H61, &H72, &H69}

        Public Structure UserEntry
            Public Username As String
            Public encPassword As String
            Public decPassword As String
            Public Description As String
            Public Label As String
            Public Path As String
            Public Comment As String
            Public Server As String
            Public Protocol As Integer
            Public AuthenticationType As Integer
            Public Port As Integer
            Public UserIndex As Integer
        End Structure

        Public Shared Function FetchUserEntries() As UserEntry()
            Dim plutilPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles) & "\Common Files\Apple\Apple Application Support\plutil.exe"
            Dim rawKeychainPath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\Apple Computer\Preferences\keychain.plist"
            Dim fixedPath As String = Nothing

            If Not ConvertKeychain(plutilPath, rawKeychainPath, fixedPath) Then
                Return Nothing
            End If

            Return ParseEntries(fixedPath.Remove(fixedPath.Length - 2)).ToArray()
        End Function

        Private Shared Function ParseEntries(ByVal keychain As String) As List(Of UserEntry)
            Dim full As String = File.ReadAllText(keychain)
            Dim outEntries As New List(Of UserEntry)()
            Dim blocks As String()

            For i As Integer = 1 To (InlineAssignHelper(blocks, Regex.Split(Regex.Split(full, "<array>")(1), "<dict>"))).Length - 1
                Dim tmpEntry As New UserEntry()

                tmpEntry.Username = GetBetween(blocks(i), "<string>", "</string>", 0)
                tmpEntry.AuthenticationType = Int32.Parse(GetBetween(blocks(i), "<integer>", "</integer>", 0))
                tmpEntry.Comment = GetBetween(blocks(i), "<string>", "</string>", 1)
                tmpEntry.encPassword = GetBetween(blocks(i), "<data>", "</data>", 0)
                tmpEntry.Description = GetBetween(blocks(i), "<string>", "</string>", 2)
                tmpEntry.Label = GetBetween(blocks(i), "<string>", "</string>", 3)
                tmpEntry.Path = GetBetween(blocks(i), "<string>", "</string>", 4)
                tmpEntry.Port = Int32.Parse(GetBetween(blocks(i), "<integer>", "</integer>", 1))
                tmpEntry.Protocol = Int32.Parse(GetBetween(blocks(i), "<integer>", "</integer>", 2))
                tmpEntry.Server = GetBetween(blocks(i), "<string>", "</string>", 5)
                tmpEntry.UserIndex = i - 1

                tmpEntry.decPassword = DecryptPassword(Convert.FromBase64String(tmpEntry.encPassword))

                outEntries.Add(tmpEntry)
            Next

            Return outEntries
        End Function

        Private Shared Function DecryptPassword(ByVal pwBuffer As Byte()) As String
            Dim dIn As DATA_BLOB, dOut As DATA_BLOB, optEntropy As DATA_BLOB
            Dim pwLen As Integer = 0
            Dim outStr As Char()

            'I think we need to marshal the buffer manually in VB.NET?
            Dim p_pwBuffer = Marshal.AllocHGlobal(pwBuffer.Length + 4) ' we need to make an extra 4 byte space for integer
            Marshal.Copy(pwBuffer, 0, p_pwBuffer, pwBuffer.Length)

            'Same with salt
            Dim p_salt = Marshal.AllocHGlobal(salt.Length)
            Marshal.Copy(salt, 0, p_salt, salt.Length)

            dIn.cbData = pwBuffer.Length
            dIn.pbData = p_pwBuffer

            optEntropy.cbData = salt.Length
            optEntropy.pbData = p_salt

            If Not CryptUnprotectData(dIn, Nothing, optEntropy, IntPtr.Zero, IntPtr.Zero, 0, dOut) Then
                Return Nothing
            End If

            'Probably have to free allocated memory for pwBuffer and salt as well
            Marshal.FreeHGlobal(p_pwBuffer)
            Marshal.FreeHGlobal(p_salt)

            pwLen = Marshal.ReadInt32(dOut.pbData)
            Dim bData As Byte() = New Byte(pwLen) {}

            dOut.pbData = New IntPtr(dOut.pbData.ToInt32() + 4) ' skip pw length
            Marshal.Copy(dOut.pbData, bData, 0, pwLen)

            LocalFree(dOut.pbData)

            outStr = New Char(pwLen - 1) {}

            For i As Integer = 0 To pwLen - 1
                outStr(i) = ChrW(bData(i))
            Next

            Return New String(outStr)
        End Function

        Private Shared Function ConvertKeychain(ByVal plutil As String, ByVal keychain As String, ByRef fixedPath As String) As Boolean
            fixedPath = Nothing

            If Not File.Exists(plutil) Then
                Return False
            End If

            Dim p As New Process()
            p.StartInfo.FileName = plutil
            p.StartInfo.Arguments = " -convert xml1 -s -o """ & (InlineAssignHelper(fixedPath, Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly().Location) + "\fixed_keychain.xml"" ")) & """" & keychain & """"
            p.StartInfo.CreateNoWindow = False
            p.StartInfo.RedirectStandardOutput = True
            p.StartInfo.UseShellExecute = False
            p.Start()
            p.WaitForExit()

            Return p.StandardOutput.ReadToEnd().Length = 0
        End Function

        Private Shared Function GetBetween(ByVal input As String, ByVal str1 As String, ByVal str2 As String, ByVal index As Integer) As String
            Dim temp As String = Regex.Split(input, str1)(index + 1)
            Return Regex.Split(temp, str2)(0)
        End Function
        Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
            target = value
            Return value
        End Function
    End Class