Imports System
Imports System.Collections.Generic
Imports System.Configuration
Imports System.IO
Imports System.Security.Principal
Imports System.Text
Imports System.Threading
Imports System.Web.Services.Protocols
Imports System.Xml
Imports System.Xml.Serialization

Public Class AuthenticationExtension
    Inherits SoapExtension

    Public Overloads Overrides Function GetInitializer(ByVal serviceType As Type) As Object
        Return Nothing
    End Function

    Public Overloads Overrides Function GetInitializer(ByVal methodInfo As LogicalMethodInfo, ByVal attribute As SoapExtensionAttribute) As Object
        Return Nothing
    End Function

    Public Overloads Overrides Sub Initialize(ByVal initializer As Object)
    End Sub

    Public Overloads Overrides Sub ProcessMessage(ByVal message As SoapMessage)
        If TypeOf message Is SoapClientMessage AndAlso message.Stage = SoapMessageStage.BeforeSerialize Then
            AddTicket(message)
        End If
        If TypeOf message Is SoapServerMessage AndAlso message.Stage = SoapMessageStage.AfterDeserialize Then
            CheckTicket(message)
        End If
    End Sub

    Private Sub AddTicket(ByVal message As SoapMessage)
        If Not TypeOf My.User.CurrentPrincipal Is MyPrincipal Then
            Return
        End If

        Dim principal As MyPrincipal = CType(My.User.CurrentPrincipal, MyPrincipal)
        If Not principal.Identity.IsAuthenticated Then
            Return
        End If
        Dim header As AuthenticationHeader = New AuthenticationHeader
        header.Name = principal.MyIdentity.Ticket.Name
        header.Expiration = principal.MyIdentity.Ticket.Expiration
        header.Roles = principal.MyIdentity.Ticket.Roles
        header.UserData = principal.MyIdentity.Ticket.UserData
        message.Headers.Add(header)
    End Sub

    Private Sub CheckTicket(ByVal message As SoapMessage)
        For Each header As SoapHeader In message.Headers
            If Not TypeOf header Is SoapUnknownHeader Then
                Continue For
            End If
            Dim unknownHeader As SoapUnknownHeader = CType(header, SoapUnknownHeader)
            If Not (unknownHeader.Element.NamespaceURI = AuthenticationHeader.HeaderName) Then
                Continue For
            End If
            Dim serializer As XmlSerializer = New XmlSerializer(GetType(AuthenticationHeader))
            Dim reader As XmlNodeReader = New XmlNodeReader(unknownHeader.Element)
            Dim authHeader As AuthenticationHeader = CType(serializer.Deserialize(reader), AuthenticationHeader)
            Dim identity As GenericIdentity = New GenericIdentity(authHeader.Name)
            Thread.CurrentPrincipal = New GenericPrincipal(identity, authHeader.Roles)
        Next
    End Sub
End Class
