ayanova7/source/csla10/CSLA.Server.DataPortal/DataPortal.vb

Imports System.Reflection
Imports System.Security.Principal
'case 1012
Imports System.Runtime.Serialization.Formatters.Binary
Imports System.IO.Compression
Imports System.IO
'Imports System.Configuration


Namespace Server

  ''' <summary>
  ''' Implements the server-side DataPortal as discussed
  ''' in Chapter 5.
  ''' </summary>
  Public Class DataPortal
    Inherits MarshalByRefObject

#Region " Data Access "

    ''' <summary>
    ''' Called by the client-side DataPortal to create a new object.
    ''' </summary>
    ''' <param name="Criteria">Object-specific criteria.</param>
        ''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
    ''' <returns>A populated business object.</returns>
    Public Function Create(ByVal Criteria As Object, ByVal context As DataPortalContext) As Object

      SetPrincipal(context.Principal)

      ' create an instance of the business object
      Dim obj As Object = CreateBusinessObject(Criteria)

      ' tell the business object to fetch its data
      CallMethod(obj, "DataPortal_Create", Criteria)
      ' return the populated business object as a result
      If context.IsRemotePortal Then
        Serialization.SerializationNotification.OnSerializing(obj)
      End If
      Return obj

    End Function

    ''' <summary>
    ''' Called by the client-side DataProtal to retrieve an object.
    ''' </summary>
    ''' <param name="Criteria">Object-specific criteria.</param>
        ''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
    ''' <returns>A populated business object.</returns>
    Public Function Fetch(ByVal Criteria As Object, ByVal context As DataPortalContext) As Object
      SetPrincipal(context.Principal)

      ' create an instance of the business object
      Dim obj As Object = CreateBusinessObject(Criteria)

      ' tell the business object to fetch its data
      CallMethod(obj, "DataPortal_Fetch", Criteria)

      ' return the populated business object as a result
            'If context.IsRemotePortal Then

            '    Serialization.SerializationNotification.OnSerializing(obj)
            'End If

            'case 1012
            If context.IsRemotePortal Then
                Return Compress(obj)
            Else
                Return obj
            End If
            'Return obj

    End Function

    ''' <summary>
    ''' Called by the client-side DataPortal to update an object.
    ''' </summary>
    ''' <param name="obj">A reference to the object being updated.</param>
        ''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
        ''' <returns>A reference to the newly updated object.</returns>
        Public Function Update(ByVal obj As Object, ByVal context As DataPortalContext) As Object

            SetPrincipal(context.Principal)
            Dim canCompress As Boolean = True

            'case 1012
            If context.IsRemotePortal AndAlso canCompress Then

                'it's coming from the client compressed so decompress first
                'Note servicebank can't be compressed due to transaction object not being serializable
                If (obj.GetType().ToString() <> "GZTW.AyaNova.BLL.ServiceBank") Then
                    obj = Decompress(DirectCast(obj, Byte()))
                Else

                    canCompress = False
                End If
            End If


            ' tell the business object to update itself
            CallMethod(obj, "DataPortal_Update")



            'case 1012
            If context.IsRemotePortal AndAlso canCompress Then
                'It's going back to the client remotely so compress it first
                Return Compress(obj)
            Else
                Return obj
            End If
            'Return obj

        End Function

    ''' <summary>
    ''' Called by the client-side DataPortal to delete an object.
    ''' </summary>
    ''' <param name="Criteria">Object-specific criteria.</param>
        ''' <param name="context">The user's principal object (if using CSLA .NET security).</param>
    Public Sub Delete(ByVal Criteria As Object, ByVal context As DataPortalContext)

      SetPrincipal(context.Principal)

      ' create an instance of the business object
      Dim obj As Object = CreateBusinessObject(Criteria)

      ' tell the business object to delete itself
      CallMethod(obj, "DataPortal_Delete", Criteria)

    End Sub

#End Region


#Region "Compression" 'case 1012
        Private Shared bSerializer As New BinaryFormatter
        Public Shared Function Compress(ByVal obj As Object) As Byte()
            Dim ms3 As New MemoryStream
            Dim cmp3 As New GZipStream(ms3, CompressionMode.Compress, False)
            bSerializer.Serialize(cmp3, obj)
            cmp3.Flush()
            cmp3.Close()
            Return ms3.ToArray()
        End Function
        Public Shared Function Decompress(ByVal bytes() As Byte) As Object
            Dim ms4 As New MemoryStream(bytes)
            Dim cmp4 As New GZipStream(ms4, CompressionMode.Decompress)
            Dim o As Object = bSerializer.Deserialize(cmp4)
            Return o
        End Function
#End Region



#Region " Security "

        Private Function AUTHENTICATION() As String

            Return "CSLA" 'System.CoXXXnfiguration.ConfigurationManager.AppSettings("Authentication")

        End Function

        Private Sub SetPrincipal(ByVal Principal As Object)

            Dim objPrincipal As IPrincipal
            Dim objIdentity As IIdentity

            If AUTHENTICATION() = "Windows" Then
                ' When using integrated security, Principal must be Nothing 
                If Principal Is Nothing Then
                    ' Set .NET to use integrated security 
                    AppDomain.CurrentDomain.SetPrincipalPolicy(PrincipalPolicy.WindowsPrincipal)
                    Exit Sub

                Else
                    Throw New Security.SecurityException( _
                      "No principal object should be passed to DataPortal when using Windows integrated security")
                End If
            End If

            ' We expect the Principal to be of the type BusinessPrincipal, but we can't enforce 
            ' that since it causes a circular reference with the business library. 
            ' Instead we must use type Object for the parameter, so here we do a check 
            ' on the type of the parameter. 
            objPrincipal = CType(Principal, IPrincipal)
            If Not (objPrincipal Is Nothing) Then
                objIdentity = objPrincipal.Identity
                If Not (objIdentity Is Nothing) Then
                    If objIdentity.AuthenticationType = "CSLA" Then
                        ' See if our current principal is different from the caller's principal 
                        If Not ReferenceEquals(Principal, _
                            System.Threading.Thread.CurrentPrincipal) Then

                            ' The caller had a different principal, so change ours to match the 
                            ' caller's, so all our objects use the caller's security. 
                            System.Threading.Thread.CurrentPrincipal = CType(Principal,  _
                              IPrincipal)
                        End If

                    Else
                        Throw New Security.SecurityException( _
                          "Principal must be of type BusinessPrincipal, not " & Principal.ToString())
                    End If

                End If

            Else
                Throw New Security.SecurityException( _
                  "Principal must be of type BusinessPrincipal, not Nothing")
            End If

        End Sub

#End Region

#Region " Creating the business object "

        Private Function CreateBusinessObject(ByVal Criteria As Object) As Object

            Dim businessType As Type

            If Criteria.GetType.IsSubclassOf(GetType(CriteriaBase)) Then
                ' get the type of the actual business object
                ' from CriteriaBase (using the new scheme)
                businessType = CType(Criteria, CriteriaBase).ObjectType

            Else
                ' get the type of the actual business object
                ' based on the nested class scheme in the book
                businessType = Criteria.GetType.DeclaringType
            End If

            ' create an instance of the business object
            Return Activator.CreateInstance(businessType, True)

        End Function

#End Region

#Region " Calling a method "

        Private Function CallMethod(ByVal obj As Object, ByVal method As String, ByVal ParamArray params() As Object) As Object

            ' call a private method on the object
            Dim info As MethodInfo = GetMethod(obj.GetType, method)
            Dim result As Object

            Try
                result = info.Invoke(obj, params)

            Catch e As Exception
                Throw 'e.InnerException
            End Try
            Return result

        End Function

        Private Function GetMethod(ByVal ObjectType As Type, ByVal method As String) As MethodInfo

            Return ObjectType.GetMethod(method, _
              BindingFlags.FlattenHierarchy Or _
              BindingFlags.Instance Or _
              BindingFlags.Public Or _
              BindingFlags.NonPublic)

        End Function

#End Region

  End Class

End Namespace