source/csla10/Backup/NetRun/AssemblyInfo.vb

@@ -0,0 +1,31 @@
+Imports System.Reflection
+Imports System.Runtime.InteropServices
+
+' General Information about an assembly is controlled through the following 
+' set of attributes. Change these attribute values to modify the information
+' associated with an assembly.
+
+' Review the values of the assembly attributes
+
+<Assembly: AssemblyTitle("NetRun")> 
+<Assembly: AssemblyDescription("No-touch deployment utility")> 
+<Assembly: AssemblyCompany("Rockford Lhotka")> 
+<Assembly: AssemblyProduct("NetRun")> 
+<Assembly: AssemblyCopyright("Copyright 2003 Rockford Lhotka. All rights reserved.")> 
+<Assembly: AssemblyTrademark("")> 
+<Assembly: CLSCompliant(True)> 
+
+'The following GUID is for the ID of the typelib if this project is exposed to COM
+<Assembly: Guid("65567A5E-28FC-48E1-B027-F79552E755A9")> 
+
+' Version information for an assembly consists of the following four values:
+'
+'      Major Version
+'      Minor Version 
+'      Build Number
+'      Revision
+'
+' You can specify all the values or you can default the Build and Revision Numbers 
+' by using the '*' as shown below:
+
+<Assembly: AssemblyVersion("1.3.*")> 

source/csla10/Backup/NetRun/Launcher.vb

@@ -0,0 +1,174 @@
+Imports System.Reflection
+Imports System.Security
+Imports System.Security.Policy
+Imports System.Security.Permissions
+
+Public Class Launcher
+  Inherits MarshalByRefObject
+
+  Private mAppURL As String
+  Private mAppDir As String
+  Private mAppName As String
+
+  Private mGroupExisted As Boolean
+
+  Public Sub RunApp(ByVal AppURL As String)
+
+    ' before we do anything, invoke the workaround
+    ' for the serialization bug
+    SerializationWorkaround()
+
+    Try
+      ' get and parse the URL for the app we are
+      ' launching
+      mAppURL = AppURL
+      mAppDir = GetAppDirectory(mAppURL)
+      mAppName = GetAppName(mAppURL)
+
+      ' TODO: MAKE SURE TO TIGHTEN SECURITY BEFORE USING!!!!
+      ' see http://www.lhotka.net/Articles.aspx?id=2f5a8115-b425-4aa1-bae2-b8f80766ecb3
+      SetSecurity()
+
+      ' load the assembly into our AppDomain
+      Dim asm As [Assembly]
+      asm = [Assembly].LoadFrom(AppURL)
+
+      ' run the program by invoking its entry point
+      asm.EntryPoint.Invoke(asm.EntryPoint, Nothing)
+
+    Finally
+      RemoveSecurity()
+    End Try
+
+  End Sub
+
+#Region " Serialization bug workaround "
+
+  Private Sub SerializationWorkaround()
+
+    ' hook up the AssemblyResolve
+    ' event so deep serialization works properly
+    ' this is a workaround for a bug in the .NET runtime
+    Dim currentDomain As AppDomain = AppDomain.CurrentDomain
+
+    AddHandler currentDomain.AssemblyResolve, _
+      AddressOf ResolveEventHandler
+
+  End Sub
+
+  Private Function ResolveEventHandler(ByVal sender As Object, ByVal args As ResolveEventArgs) As [Assembly]
+
+    ' get a list of all the assemblies loaded in our appdomain
+    Dim list() As [Assembly] = AppDomain.CurrentDomain.GetAssemblies()
+
+    ' search the list to find the assemby that was not found automatically
+    ' and return the assembly from the list
+    Dim asm As [Assembly]
+
+    For Each asm In list
+      If asm.FullName = args.Name Then
+        Return asm
+      End If
+    Next
+
+  End Function
+
+#End Region
+
+#Region " SetSecurity to FullTrust "
+
+  Private Sub SetSecurity()
+
+    Dim ph As System.Collections.IEnumerator
+    Dim pl As System.Security.Policy.PolicyLevel
+    Dim found As Boolean
+
+    ' retrieve the security policy hierarchy
+    ph = SecurityManager.PolicyHierarchy
+
+    ' loop through to find the Machine level sub-tree
+    Do While ph.MoveNext
+      pl = CType(ph.Current, PolicyLevel)
+      If pl.Label = "Machine" Then
+        found = True
+        Exit Do
+      End If
+    Loop
+
+    If found Then
+      ' see if the codegroup for this app already exists
+      ' as a machine-level entry
+      Dim cg As CodeGroup
+      For Each cg In pl.RootCodeGroup.Children
+        If cg.Name = mAppName Then
+          ' codegroup already exists
+          ' we assume it is set to a valid
+          ' permission level
+          mGroupExisted = True
+          Exit Sub
+        End If
+      Next
+
+      ' the codegroup doesn't already exist, so 
+      ' we'll add a url group with FullTrust
+      mGroupExisted = False
+      Dim ucg As UnionCodeGroup = _
+        New UnionCodeGroup(New UrlMembershipCondition(mAppDir & "/*"), _
+        New PolicyStatement(New NamedPermissionSet("FullTrust")))
+      ucg.Description = "Temporary entry for " & mAppURL
+      ucg.Name = mAppName
+      pl.RootCodeGroup.AddChild(ucg)
+      SecurityManager.SavePolicy()
+    End If
+
+  End Sub
+
+#End Region
+
+#Region " RemoveSecurity "
+
+  Private Sub RemoveSecurity()
+
+    ' if the group existed before NetRun was used
+    ' we want to leave the group intact, so we
+    ' can just exit
+    If mGroupExisted Then Exit Sub
+
+    ' on the other hand, if the group didn't already
+    ' exist then we need to remove it now that
+    ' the business application is closed
+    Dim ph As System.Collections.IEnumerator
+    Dim pl As System.Security.Policy.PolicyLevel
+    Dim found As Boolean
+
+    ' retrieve the security policy hierarchy
+    ph = SecurityManager.PolicyHierarchy
+
+    ' loop through to find the Machine level sub-tree
+    Do While ph.MoveNext
+      pl = CType(ph.Current, PolicyLevel)
+      If pl.Label = "Machine" Then
+        found = True
+        Exit Do
+      End If
+    Loop
+
+    If found Then
+      ' see if the codegroup for this app exists
+      ' as a machine-level entry
+      Dim cg As CodeGroup
+      For Each cg In pl.RootCodeGroup.Children
+        If cg.Name = mAppName Then
+          ' codegroup exits - remove it
+          pl.RootCodeGroup.RemoveChild(cg)
+          SecurityManager.SavePolicy()
+          Exit For
+        End If
+      Next
+    End If
+
+  End Sub
+
+#End Region
+
+End Class

source/csla10/Backup/NetRun/Main.vb

@@ -0,0 +1,114 @@
+Imports System.IO
+Imports System.Reflection
+Imports System.Security
+Imports System.Security.Policy
+Imports System.Security.Permissions
+
+Module Main
+
+  Public Sub Main()
+
+    Try
+      ' launch the app based on the URL provided by the user
+      RunAppliation(Microsoft.VisualBasic.Command)
+
+    Catch ex As Exception
+      Dim sb As New System.Text.StringBuilder()
+      sb.Append("NetRun was unable to launch the application")
+      sb.Append(vbCrLf)
+      sb.Append(Microsoft.VisualBasic.Command)
+      sb.Append(vbCrLf)
+      sb.Append(vbCrLf)
+      sb.Append(ex.ToString)
+      MsgBox(sb.ToString, MsgBoxStyle.Exclamation)
+    End Try
+
+  End Sub
+
+#Region " RunApplication "
+
+  Private Sub RunAppliation(ByVal AppURL As String)
+
+    ' create setup object for the new app domain 
+    Dim setupDomain As New AppDomainSetup()
+    With setupDomain
+      ' give it a valid base path
+      .ApplicationBase = CurrentDomainPath()
+      ' give it a safe config file name
+      .ConfigurationFile = AppURL + ".remoteconfig"
+    End With
+
+    ' create new application domain 
+    Dim newDomain As AppDomain = _
+      AppDomain.CreateDomain( _
+      GetAppName(AppURL), Nothing, setupDomain)
+
+    ' create launcher object in new appdomain
+    Dim launcher As Launcher = _
+      CType(newDomain.CreateInstanceAndUnwrap( _
+      "NetRun", "NetRun.Launcher"), _
+      Launcher)
+
+    ' use launcher object from the new domain
+    ' to launch the remote app in that appdomain
+    launcher.RunApp(AppURL)
+
+  End Sub
+
+#End Region
+
+#Region " GetCurrentDomainPath "
+
+  Private Function CurrentDomainPath() As String
+
+    ' get path of current assembly
+    Dim currentPath As String = [Assembly].GetExecutingAssembly.CodeBase
+    ' convert it to a URI for ease of use
+    Dim currentURI As Uri = New Uri(currentPath)
+    ' get the path portion of the URI
+    Dim currentLocalPath As String = currentURI.LocalPath
+
+    ' return the full name of the path
+    Return New DirectoryInfo(currentLocalPath).Parent.FullName
+
+  End Function
+
+#End Region
+
+#Region " URL parsing functions "
+
+  Public Function GetAppDirectory(ByVal AppURL As String) As String
+
+    ' get the path without prog name
+    Dim appURI As New System.Uri(AppURL)
+    Dim appPath As String = appURI.GetLeftPart(UriPartial.Path)
+    Dim pos As Integer
+
+    For pos = Len(appPath) To 1 Step -1
+      If Mid(appPath, pos, 1) = "/" OrElse Mid(appPath, pos, 1) = "\" Then
+        Return Left(appPath, pos - 1)
+      End If
+    Next
+    Return ""
+
+  End Function
+
+  Public Function GetAppName(ByVal AppURL As String) As String
+
+    ' get the prog name without path
+    Dim appURI As New System.Uri(AppURL)
+    Dim appPath As String = appURI.GetLeftPart(UriPartial.Path)
+    Dim pos As Integer
+
+    For pos = Len(appPath) To 1 Step -1
+      If Mid(appPath, pos, 1) = "/" OrElse Mid(appPath, pos, 1) = "\" Then
+        Return Mid(appPath, pos + 1)
+      End If
+    Next
+    Return ""
+
+  End Function
+
+#End Region
+
+End Module

source/csla10/Backup/NetRun/NetRun.vbproj

@@ -0,0 +1,35 @@
+<VisualStudioProject>
+    <VisualBasic ProjectType="Local" ProductVersion="7.10.3077" SchemaVersion="2.0" ProjectGuid="{24FFD3D5-D449-403F-88F3-04D9E17422A6}">
+        <Build>
+            <Settings ApplicationIcon="" AssemblyKeyContainerName="" AssemblyName="NetRun" AssemblyOriginatorKeyFile="" AssemblyOriginatorKeyMode="None" DefaultClientScript="JScript" DefaultHTMLPageLayout="Grid" DefaultTargetSchema="IE50" DelaySign="false" OutputType="WinExe" OptionCompare="Binary" OptionExplicit="On" OptionStrict="Off" RootNamespace="NetRun" StartupObject="">
+                <Config Name="Debug" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="true" DefineTrace="true" DebugSymbols="true" IncrementalBuild="true" Optimize="false" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
+                <Config Name="Release" BaseAddress="285212672" ConfigurationOverrideFile="" DefineConstants="" DefineDebug="false" DefineTrace="true" DebugSymbols="false" IncrementalBuild="false" Optimize="true" OutputPath="bin\" RegisterForComInterop="false" RemoveIntegerChecks="false" TreatWarningsAsErrors="false" WarningLevel="1" />
+            </Settings>
+            <References>
+                <Reference Name="System" AssemblyName="System" />
+                <Reference Name="System.Data" AssemblyName="System.Data" />
+                <Reference Name="System.Drawing" AssemblyName="System.Drawing" />
+                <Reference Name="System.Windows.Forms" AssemblyName="System.Windows.Forms" />
+                <Reference Name="System.XML" AssemblyName="System.Xml" />
+            </References>
+            <Imports>
+                <Import Namespace="Microsoft.VisualBasic" />
+                <Import Namespace="System" />
+                <Import Namespace="System.Collections" />
+                <Import Namespace="System.Data" />
+                <Import Namespace="System.Drawing" />
+                <Import Namespace="System.Diagnostics" />
+                <Import Namespace="System.Windows.Forms" />
+            </Imports>
+        </Build>
+        <Files>
+            <Include>
+                <File RelPath="AssemblyInfo.vb" SubType="Code" BuildAction="Compile" />
+                <File RelPath="Launcher.vb" SubType="Code" BuildAction="Compile" />
+                <File RelPath="Main.vb" SubType="Code" BuildAction="Compile" />
+            </Include>
+        </Files>
+        <UserProperties GenerateXMLDocForProject="FALSE" />
+    </VisualBasic>
+</VisualStudioProject>
+

source/csla10/Backup/NetRun/NetRun.vbproj.user

@@ -0,0 +1,48 @@
+<VisualStudioProject>
+    <VisualBasic LastOpenVersion = "7.10.3077" >
+        <Build>
+            <Settings ReferencePath = "" >
+                <Config
+                    Name = "Debug"
+                    EnableASPDebugging = "false"
+                    EnableASPXDebugging = "false"
+                    EnableUnmanagedDebugging = "false"
+                    EnableSQLServerDebugging = "false"
+                    RemoteDebugEnabled = "false"
+                    RemoteDebugMachine = ""
+                    StartAction = "Project"
+                    StartArguments = ""
+                    StartPage = ""
+                    StartProgram = ""
+                    StartURL = ""
+                    StartWorkingDirectory = ""
+                    StartWithIE = "false"
+                />
+                <Config
+                    Name = "Release"
+                    EnableASPDebugging = "false"
+                    EnableASPXDebugging = "false"
+                    EnableUnmanagedDebugging = "false"
+                    EnableSQLServerDebugging = "false"
+                    RemoteDebugEnabled = "false"
+                    RemoteDebugMachine = ""
+                    StartAction = "Project"
+                    StartArguments = ""
+                    StartPage = ""
+                    StartProgram = ""
+                    StartURL = ""
+                    StartWorkingDirectory = ""
+                    StartWithIE = "false"
+                />
+            </Settings>
+        </Build>
+        <OtherProjectSettings
+            CopyProjectDestinationFolder = ""
+            CopyProjectUncPath = ""
+            CopyProjectOption = "0"
+            ProjectView = "ProjectFiles"
+            ProjectTrust = "0"
+        />
+    </VisualBasic>
+</VisualStudioProject>
+