#light namespace Microsoft.FSharp.Compiler module MSBuildResolver = open System open Microsoft.Build.Tasks open Microsoft.Build.Utilities open Microsoft.Build.Framework open Microsoft.Build.BuildEngine open System.IO exception ResolutionFailure type ResolvedFrom = | AssemblyFolders | AssemblyFoldersEx | TargetFrameworkDirectory | RawFileName | GlobalAssemblyCache | Path of string | Unknown type ResolvedFile = { itemSpec:string resolvedFrom:ResolvedFrom fusionName:string version:string redist:string baggage:string } with override this.ToString() = sprintf "ResolvedFile(%s)" this.itemSpec type ResolutionResults = { resolvedFiles:ResolvedFile array referenceDependencyPaths:string array relatedPaths:string array referenceSatellitePaths:string array referenceScatterPaths:string array referenceCopyLocalPaths:string array suggestedBindingRedirects:string array } let ReplaceFrameworkVariables(dirs) = let windowsFramework = System.Environment.GetEnvironmentVariable("windir")+ @"\Microsoft.NET\Framework" let referenceAssemblies = System.Environment.GetEnvironmentVariable("ProgramFiles")+ @"\Reference Assemblies\Microsoft\Framework" dirs|>List.map(fun (d:string)->d.Replace("{WindowsFramework}",windowsFramework).Replace("{ReferenceAssemblies}",referenceAssemblies)) #if FX_ATLEAST_40 /// The .NET runtime version that F# was built against. let DotNetRuntime = sprintf "v%s.%s.%s" Microsoft.BuildSettings.Version.Major Microsoft.BuildSettings.Version.Minor Microsoft.BuildSettings.Version.ProductBuild /// The short version (like 4.0) that F# was built against. let DotNetRuntimeShort = sprintf "v%s.%s" Microsoft.BuildSettings.Version.Major Microsoft.BuildSettings.Version.Minor /// Locations of .NET framework assemblies. let DotNetFrameworkDirectories = ReplaceFrameworkVariables([@"{ReferenceAssemblies}\"+DotNetRuntimeShort; @"{WindowsFramework}\"+DotNetRuntime]) #endif /// Derive the target framework directories. let DeriveTargetFrameworkDirectories (targetFrameworkVersion:string, // e.g. v2.0, v3.0, v3.5, v4.0 etc frameworkRegistryBase:string, // Software\Microsoft\.NetFramework logmessage:string->unit) = let targetFrameworkVersion = if not(targetFrameworkVersion.StartsWith("v",StringComparison.Ordinal)) then "v"^targetFrameworkVersion else targetFrameworkVersion let FrameworkStartsWith(short) = targetFrameworkVersion.StartsWith(short,StringComparison.Ordinal) let result = if FrameworkStartsWith("v1.0") then ReplaceFrameworkVariables([@"{WindowsFramework}\v1.0.3705"]) else if FrameworkStartsWith("v1.1") then ReplaceFrameworkVariables([@"{WindowsFramework}\v1.1.4322"]) else if FrameworkStartsWith("v2.0") then ReplaceFrameworkVariables([@"{WindowsFramework}\v2.0.50727"]) else if FrameworkStartsWith("v3.0") then ReplaceFrameworkVariables([@"{ReferenceAssemblies}\v3.0"; @"{WindowsFramework}\v3.0"; @"{WindowsFramework}\v2.0.50727"]) else if FrameworkStartsWith("v3.5") then ReplaceFrameworkVariables([@"{ReferenceAssemblies}\v3.5"; @"{WindowsFramework}\v3.5"; @"{WindowsFramework}\v2.0.50727"]) #if FX_ATLEAST_40 else ReplaceFrameworkVariables(DotNetFrameworkDirectories) #else else [] #endif let result = result |> Array.of_list logmessage (sprintf "Derived target framework directories for version %s are: %s" targetFrameworkVersion (String.Join(",", result))) result /// Decode the ResolvedFrom code from MSBuild. let DecodeResolvedFrom(resolvedFrom:string) : ResolvedFrom = let Same a b = String.CompareOrdinal(a,b) = 0 match resolvedFrom with | r when Same "{RawFileName}" r -> RawFileName | r when Same "{GAC}" r -> GlobalAssemblyCache | r when Same "{TargetFrameworkDirectory}" r -> TargetFrameworkDirectory | r when Same "{AssemblyFolders}" r -> AssemblyFolders | r when Same "{GAC}" r -> GlobalAssemblyCache | r when r.Length >= 10 && Same "{Registry:" (r.Substring(0,10)) -> AssemblyFoldersEx | r -> Path r type ErrorWarningCallbackSig = ((*code:*)string->(*message*)string->unit) type ResolutionEnvironment = CompileTimeLike | RuntimeLike type Foregrounded = | ForegroundedMessage of string | ForegroundedError of string * string | ForegroundedWarning of string * string let ResolveCore( resolutionEnvironment: ResolutionEnvironment, references:(string*(*baggage*)string)[], targetFrameworkVersion:string, targetFrameworkDirectories:string list, targetProcessorArchitecture:string, outputDirectory:string, fsharpBinariesDir:string, explicitIncludeDirs:string list, implicitIncludeDir:string, frameworkRegistryBase:string, assemblyFoldersSuffix:string, assemblyFoldersConditions:string, allowRawFileName:bool, logmessage:string->unit, logwarning:ErrorWarningCallbackSig, logerror:ErrorWarningCallbackSig ) = // Message Foregrounding: // In version 4.0 MSBuild began calling log methods on a background (non-UI) thread. If there is an exception thrown from // logmessage, logwarning or logerror then it would kill the process. // The fix is to catch these exceptions and log the rest of the messages to a list to output at the end. // It looks simpler to always just accumulate the messages during resolution and show them all at the end, but then // we couldn't see the messages as resolution progresses. let foregrounded = ref [] let backgroundException : exn option ref = ref None let logmessage message = match !backgroundException with | Some(_) -> foregrounded := ForegroundedMessage(message) :: !foregrounded | None -> try logmessage message with e -> backgroundException := Some(e) foregrounded := ForegroundedMessage(message) :: !foregrounded let logwarning code message = match !backgroundException with | Some(_) -> foregrounded := ForegroundedWarning(code,message) :: !foregrounded | None -> try logwarning code message with e -> backgroundException := Some(e) foregrounded := ForegroundedWarning(code,message) :: !foregrounded let logerror code message = match !backgroundException with | Some(_) -> foregrounded := ForegroundedError(code,message) :: !foregrounded | None -> try logwarning code message with e -> backgroundException := Some(e) foregrounded := ForegroundedError(code,message) :: !foregrounded let engine = { new IBuildEngine with member be.BuildProjectFile(projectFileName, targetNames, globalProperties, targetOutputs) = true member be.LogCustomEvent(e) = logmessage e.Message member be.LogErrorEvent(e) = logerror e.Code e.Message member be.LogMessageEvent(e) = logmessage e.Message member be.LogWarningEvent(e) = logwarning e.Code e.Message member be.ColumnNumberOfTaskNode with get() = 1 member be.LineNumberOfTaskNode with get() = 1 member be.ContinueOnError with get() = true member be.ProjectFileOfTaskNode with get() = "" } let rar = new ResolveAssemblyReference() rar.BuildEngine <- engine // Derive target framework directory if none was supplied. let targetFrameworkDirectories = if targetFrameworkDirectories=[] then DeriveTargetFrameworkDirectories(targetFrameworkVersion,frameworkRegistryBase,logmessage) else targetFrameworkDirectories |> Array.of_list // Filter for null and zero length, and escape backslashes so legitimate path characters aren't mistaken for // escape characters (E.g., ".\r.dll") let explicitIncludeDirs = explicitIncludeDirs |> List.filter(fun eid->not(String.IsNullOrEmpty(eid))) let references = references |> Array.filter(fun (path,_)->not(String.IsNullOrEmpty(path))) |> Array.map (fun (path,baggage) -> (path.Replace("\\","\\\\"),baggage)) rar.TargetFrameworkDirectories <- targetFrameworkDirectories rar.FindRelatedFiles <- false rar.FindDependencies <- false rar.FindSatellites <- false rar.FindSerializationAssemblies <- false rar.TargetProcessorArchitecture <- targetProcessorArchitecture rar.Assemblies <- [|for (referenceName,baggage) in references -> let item = new Microsoft.Build.Utilities.TaskItem(referenceName) item.SetMetadata("Baggage", baggage) item:>ITaskItem|] let rawFileNamePath = if allowRawFileName then ["{RawFileName}"] else [] let searchPaths = match resolutionEnvironment with | RuntimeLike -> logmessage("Using scripting resolution precedence.") // These are search paths for runtime-like or scripting resolution. GAC searching is present. rawFileNamePath @ // Quick-resolve straight to filename first explicitIncludeDirs @ // From -I, #I [implicitIncludeDir] @ // Usually the project directory [fsharpBinariesDir] @ // Location of fsc.exe ["{TargetFrameworkDirectory}"] @ [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @ ["{AssemblyFolders}"] @ ["{GAC}"] | CompileTimeLike -> logmessage("Using compilation resolution precedence.") // These are search paths for compile-like resolution. GAC searching is not present. ["{TargetFrameworkDirectory}"] @ rawFileNamePath @ // Quick-resolve straight to filename first explicitIncludeDirs @ // From -I, #I [implicitIncludeDir] @ // Usually the project directory [fsharpBinariesDir] @ // Location of fsc.exe [sprintf "{Registry:%s,%s,%s%s}" frameworkRegistryBase targetFrameworkVersion assemblyFoldersSuffix assemblyFoldersConditions] @ ["{AssemblyFolders}"] @ [outputDirectory] rar.SearchPaths <- searchPaths |> Array.of_list rar.AllowedAssemblyExtensions <- [| ".exe"; ".dll" |] let succeeded = rar.Execute() // Unroll any foregrounded messages match !backgroundException with | Some(backGroundException) -> logwarning "" "Saw error on logger thread during resolution." logwarning "" (sprintf "%A" backGroundException) logwarning "" "Showing messages seen after exception." !foregrounded |> List.iter(fun message-> match message with | ForegroundedMessage(message) -> logmessage message | ForegroundedWarning(code,message) -> logwarning code message | ForegroundedError(code,message) -> logerror code message ) | None -> () if not succeeded then raise ResolutionFailure { resolvedFiles = [| for p in rar.ResolvedFiles -> {itemSpec = p.ItemSpec; resolvedFrom = DecodeResolvedFrom(p.GetMetadata("ResolvedFrom")); fusionName = p.GetMetadata("FusionName"); version = p.GetMetadata("Version"); redist = p.GetMetadata("Redist"); baggage = p.GetMetadata("Baggage") } |] referenceDependencyPaths = [| for p in rar.ResolvedDependencyFiles -> p.ItemSpec |] relatedPaths = [| for p in rar.RelatedFiles -> p.ItemSpec |] referenceSatellitePaths = [| for p in rar.SatelliteFiles -> p.ItemSpec |] referenceScatterPaths = [| for p in rar.ScatterFiles -> p.ItemSpec |] referenceCopyLocalPaths = [| for p in rar.CopyLocalFiles -> p.ItemSpec |] suggestedBindingRedirects = [| for p in rar.SuggestedRedirects -> p.ItemSpec |] } let Resolve( resolutionEnvironment: ResolutionEnvironment, references:(string*(*baggage*)string)[], targetFrameworkVersion:string, targetFrameworkDirectories:string list, targetProcessorArchitecture:string, outputDirectory:string, fsharpBinariesDir:string, explicitIncludeDirs:string list, implicitIncludeDir:string, frameworkRegistryBase:string, assemblyFoldersSuffix:string, assemblyFoldersConditions:string, logmessage:string->unit, logwarning:ErrorWarningCallbackSig, logerror:ErrorWarningCallbackSig ) = // The {RawFileName} target is 'dangerous', in the sense that is uses Directory.GetCurrentDirectory() to resolve unrooted file paths. // It is unreliable to use this mutable global state inside Visual Studio. As a result, we partition all references into a "rooted" set // (which contains e.g. C:\MyDir\MyAssem.dll) and "unrooted" (everything else). We only allow "rooted" to use {RawFileName}. Note that // unrooted may still find 'local' assemblies by virtue of the fact that "implicitIncludeDir" is one of the places searched during // assembly resolution. let references = references |> Array.map (fun ((file,baggage) as data) -> // However, MSBuild will not resolve 'relative' paths, even when e.g. implicitIncludeDir is part of the search. As a result, // if we have an unrooted path+filename, we'll assume this is relative to the project directory and root it. if System.IO.Path.IsPathRooted(file) then data // fine, e.g. "C:\Dir\foo.dll" elif not(file.Contains("\\") || file.Contains("/")) then data // fine, e.g. "System.Transactions.dll" else // we have a 'relative path', e.g. "bin/Debug/foo.exe" or "..\Yadda\bar.dll" // turn it into an absolute path based at implicitIncludeDir (System.IO.Path.Combine(implicitIncludeDir, file), baggage) ) let rooted, unrooted = references |> Array.partition (fun (file,baggage) -> System.IO.Path.IsPathRooted(file)) let CallResolveCore(references, allowRawFileName) = // all the params are the same... ResolveCore( resolutionEnvironment, references, // ... except this targetFrameworkVersion, targetFrameworkDirectories, targetProcessorArchitecture, outputDirectory, fsharpBinariesDir, explicitIncludeDirs, implicitIncludeDir, frameworkRegistryBase, assemblyFoldersSuffix, assemblyFoldersConditions, allowRawFileName, // ... and this logmessage, logwarning, logerror) let rootedResults = CallResolveCore(rooted, true) let unrootedResults = CallResolveCore(unrooted, false) // now unify the two sets of results { resolvedFiles = Array.concat [| rootedResults.resolvedFiles; unrootedResults.resolvedFiles |] referenceDependencyPaths = set rootedResults.referenceDependencyPaths |> Set.union (set unrootedResults.referenceDependencyPaths) |> Set.to_array relatedPaths = set rootedResults.relatedPaths |> Set.union (set unrootedResults.relatedPaths) |> Set.to_array referenceSatellitePaths = set rootedResults.referenceSatellitePaths |> Set.union (set unrootedResults.referenceSatellitePaths) |> Set.to_array referenceScatterPaths = set rootedResults.referenceScatterPaths |> Set.union (set unrootedResults.referenceScatterPaths) |> Set.to_array referenceCopyLocalPaths = set rootedResults.referenceCopyLocalPaths |> Set.union (set unrootedResults.referenceCopyLocalPaths) |> Set.to_array suggestedBindingRedirects = set rootedResults.suggestedBindingRedirects |> Set.union (set unrootedResults.suggestedBindingRedirects) |> Set.to_array }