diff --git a/Exe/Index.fs b/Exe/Index.fs index d676dc0..dfbb762 100644 --- a/Exe/Index.fs +++ b/Exe/Index.fs @@ -37,31 +37,15 @@ let run (proj:string option) (projProps:(string * string) list) let cd = Directory.GetCurrentDirectory() let pdbs = pPdbs @ ({BaseDirectory=cd; Includes=pdbs; Excludes=[]} |> List.ofSeq) - let gitFiles = {BaseDirectory=cd; Includes= pFiles @ files; Excludes=notFiles} |> List.ofSeq - let pdbVerifyFiles = {BaseDirectory=cd; Includes= pFiles @ files; Excludes=[]} |> List.ofSeq + let projectFiles = {BaseDirectory=cd; Includes= pFiles @ files; Excludes=notFiles} |> List.ofSeq - verbosefn "\nglobbed pdbs: %A" gitFiles - verbosefn "globbed gitFiles: %A" gitFiles - verbosefn "globbed pdbVerifyFiles: %A" pdbVerifyFiles - - if verifyGit then - use repo = new GitRepo(repoDir) - tracefn "verifying checksums for %d source files in Git repository" gitFiles.Length - use repo = new GitRepo(repoDir) - let different = repo.VerifyFiles gitFiles - if different.Length > 0 then - let error = sprintf "%d files do not have matching checksums in Git" different.Length - traceError error - traceErrorfn "make sure the source code is committed and line endings match" - traceErrorfn "http://ctaggart.github.io/SourceLink/how-it-works.html" - for file in different do - traceErrorfn " %s" file - failwith error + verbosefn "\nglobbed pdbs: %A" pdbs + verbosefn "globbed gitFiles: %A" projectFiles let paths = if noPaths then use repo = new GitRepo(repoDir) - repo.Paths gitFiles + repo.Paths projectFiles else paths |> Seq.ofList let commit = @@ -75,20 +59,36 @@ let run (proj:string option) (projProps:(string * string) list) let srcsrvPath = use pdb = new PdbFile(pdbPath) + + // verify checksums in the pdb 1st if verifyPdb then - let missing = pdb.VerifyChecksums pdbVerifyFiles - if missing.Count > 0 then - let error = sprintf "%d files do not have matching checksums in the pdb" missing.Count + let pc = pdb.MatchChecksums projectFiles + if pc.Unmatched.Count > 0 then + let error = sprintf "%d files do not have matching checksums in the pdb" pc.Unmatched.Count traceError error - for file, checksum in missing.KeyValues do - traceErrorfn " %s" file + for um in pc.Unmatched do + traceErrorfn " pdb %s, file %s %s" um.ChecksumInPdb um.ChecksumOfFile um.File failwith error + + // verify checksums in git 2nd + if verifyGit then + let gitFiles = pc.MatchedFiles + use repo = new GitRepo(repoDir) + tracefn "verifying checksums for %d source files in Git repository" gitFiles.Length + use repo = new GitRepo(repoDir) + let gc = repo.MatchChecksums gitFiles + if gc.Unmatched.Count > 0 then + let error = sprintf "%d files do not have matching checksums in Git" gc.Unmatched.Count + traceError error + traceErrorfn "make sure the source code is committed and line endings match" + traceErrorfn "http://ctaggart.github.io/SourceLink/how-it-works.html" + for um in gc.Unmatched do + traceErrorfn " git %s, file %s %s" um.ChecksumInGit um.ChecksumOfFile um.File + failwith error + pdb.PathSrcSrv File.WriteAllBytes(srcsrvPath, SrcSrv.create url commit paths) -// let pdbstr = Pdbstr.tryFind() -// if pdbstr.IsNone then -// failwith "pdbstr.exe not found, install Debugging Tools for Windows" let pdbstr = Path.combine (System.Reflection.Assembly.GetExecutingAssembly().Location |> Path.GetDirectoryName) "pdbstr.exe" let p = Process() diff --git a/Fake/SourceLink.fsx b/Fake/SourceLink.fsx index 5d61e20..a5fb0a2 100644 --- a/Fake/SourceLink.fsx +++ b/Fake/SourceLink.fsx @@ -6,6 +6,7 @@ //#r "../packages/LibGit2Sharp/lib/net40/LibGit2Sharp.dll" // in dev //#r "../SourceLink/bin/Debug/SourceLink.Core.dll" // in dev //#r "../Git/bin/Debug/SourceLink.Git.dll" // in dev +//#r "../packages/SourceLink.MSBuild/lib/net45/SourceLink.Build.dll" // in dev #r "SourceLink.Build.Framework.dll" #r "SourceLink.Build.dll" #r "LibGit2Sharp.dll" @@ -38,6 +39,7 @@ type Microsoft.Build.Evaluation.Project with Excludes = x.ItemsCompileLinkPath } type GitRepo with + [] member x.VerifyChecksums files = let different = x.VerifyFiles files if different.Length <> 0 then @@ -47,16 +49,6 @@ type GitRepo with logfn "no checksum match found for %s" file failwith errMsg -type Microsoft.Build.Evaluation.Project with // VsProj - member x.VerifyPdbChecksums files = - let missing = x.VerifyPdbFiles files - if missing.Count > 0 then - let errMsg = sprintf "cannot find %d source files" missing.Count - log errMsg - for file, checksum in missing.KeyValues do - logfn "cannot find %s with checksum of %s" file checksum - failwith errMsg - type Pdbstr with static member execWith exe pdb srcsrv = let workdir = Path.GetDirectoryName pdb @@ -64,10 +56,51 @@ type Pdbstr with let srcsrv = if workdir.EqualsI <| Path.GetDirectoryName srcsrv then Path.GetFileName srcsrv else srcsrv let pdb = if workdir.EqualsI <| Path.GetDirectoryName pdb then Path.GetFileName pdb else pdb let args = sprintf "-w -s:srcsrv -i:\"%s\" -p:\"%s\"" srcsrv pdb - logfn "%s>\"%s\" %s" workdir exe args + logVerbosefn "%s>\"%s\" %s" workdir exe args Shell.Exec(exe, args, workdir) |> ignore static member exec pdb srcsrv = let exe = Pdbstr.tryFind() if exe.IsNone then failwith "pdbstr.exe not found, install Debugging Tools for Windows" - Pdbstr.execWith exe.Value pdb srcsrv \ No newline at end of file + Pdbstr.execWith exe.Value pdb srcsrv + +type Microsoft.Build.Evaluation.Project with // VsProj + [] + member x.VerifyPdbChecksums files = + let missing = x.VerifyPdbFiles files + if missing.Count > 0 then + let errMsg = sprintf "cannot find %d source files" missing.Count + log errMsg + for file, checksum in missing.KeyValues do + logfn "cannot find %s with checksum of %s" file checksum + failwith errMsg + + /// Verifies the checksums for the list of files + member x.SourceIndex pdbFile sourceFiles gitRepoPath url = + logfn "source indexing %s" pdbFile + let srcsrvFile = + use pdb = new PdbFile(pdbFile) + + // verify checksums in the pdb 1st + let pc = pdb.MatchChecksums sourceFiles + if pc.Unmatched.Count > 0 then + let errMsg = sprintf "%d source files do not have matching checksums in the pdb file" pc.Unmatched.Count + log errMsg + for um in pc.Unmatched do + logfn " pdb %s, file %s %s" um.ChecksumInPdb um.ChecksumOfFile um.File + failwith errMsg + + // verify checksums in git 2nd + use repo = new GitRepo(gitRepoPath) + let gc = repo.MatchChecksums pc.MatchedFiles + if gc.Unmatched.Count > 0 then + let errMsg = sprintf "%d source files do not have matching checksums in the Git repository" gc.Unmatched.Count + log errMsg + for um in gc.Unmatched do + logfn " git %s, file %s %s" um.ChecksumInGit um.ChecksumOfFile um.File + failwith errMsg + + let srcsrvFile = pdbFile + ".srcsrv" + File.WriteAllBytes(srcsrvFile, SrcSrv.create url repo.Commit (repo.Paths pc.MatchedFiles)) + srcsrvFile + Pdbstr.exec pdbFile srcsrvFile \ No newline at end of file diff --git a/Git/GitRepo.fs b/Git/GitRepo.fs index 0e34b1e..022571c 100644 --- a/Git/GitRepo.fs +++ b/Git/GitRepo.fs @@ -6,6 +6,15 @@ open LibGit2Sharp open System.Collections.Generic open System.Runtime.InteropServices +type GitChecksum = { + File: string + ChecksumOfFile: string + ChecksumInGit: string } + +type GitChecksums = { + Matched: List + Unmatched: List } + type GitRepo(dir) = let dir = Path.absolute dir let repo = new Repository(dir) @@ -28,20 +37,18 @@ type GitRepo(dir) = static member ComputeChecksum file = GitRepo.ComputeChecksums [file] |> Seq.head |> fst - member x.Checksums files = - files |> Seq.map (fun (file:string) -> - let f = - if Path.IsPathRooted file then - file.Substring(dir.Length + 1) - else - file - let ie = repo.Index.[f] - if ie <> null then file, ie.Id.Sha - else file, "" - ) - member x.Checksum file = - x.Checksums [file] |> Seq.head |> snd + let f = + if Path.IsPathRooted file then + file.Substring(dir.Length + 1) + else + file + match repo.Index.[f] with + | null -> "" + | ie -> ie.Id.Sha + + member x.Checksums files = + files |> Seq.map (fun file -> file, x.Checksum file) member x.ChecksumSet files = let checksums = @@ -50,13 +57,24 @@ type GitRepo(dir) = |> Seq.filter (not << String.IsNullOrEmpty) HashSet(checksums, StringComparer.OrdinalIgnoreCase) + member x.MatchChecksums files = + let matched = List<_>() + let unmatched = List<_>() + for checksum, file in GitRepo.ComputeChecksums files do + let gitChecksum = x.Checksum file + let gc = { File = file; ChecksumOfFile = checksum; ChecksumInGit = gitChecksum } + if checksum = gitChecksum then + matched.Add gc + else unmatched.Add gc + { Matched = matched; Unmatched = unmatched } + /// returns a sorted list of files with checksums that do not match +// [] member x.VerifyFiles files = - let committed = x.ChecksumSet files + let mc = x.MatchChecksums files let different = SortedSet(StringComparer.OrdinalIgnoreCase) - for checksum, file in GitRepo.ComputeChecksums files do - if false = committed.Contains checksum then - different.Add file |> ignore + for gc in mc.Unmatched do + different.Add gc.File |> ignore different |> Array.ofSeq static member IsRepo dir = diff --git a/SourceLink/PdbChecksums.fs b/SourceLink/PdbChecksums.fs index 62e6277..23e07a7 100644 --- a/SourceLink/PdbChecksums.fs +++ b/SourceLink/PdbChecksums.fs @@ -4,6 +4,19 @@ module SourceLink.PdbChecksums open System open System.Collections.Generic +type PdbChecksum = { + File: string + ChecksumOfFile: string + ChecksumInPdb: string } + +type PdbChecksums = { + Matched: List + Unmatched: List } + + with + member x.MatchedFiles = + x.Matched |> Seq.map (fun fc -> fc.File) |> List.ofSeq + type PdbFile with member x.Files @@ -19,12 +32,25 @@ type PdbFile with with get() = let d = Dictionary StringComparer.OrdinalIgnoreCase x.Files - |> Seq.map (fun (file, hash) -> Hex.encode hash, file) + |> Seq.map (fun (file, checksum) -> Hex.encode checksum, file) |> d.AddAll d - member x.VerifyChecksums files = - let missing = SortedDictionary StringComparer.OrdinalIgnoreCase // file, checksum + /// A set of files and their checksums + member x.FileChecksums + with get() = + let d = Dictionary StringComparer.OrdinalIgnoreCase + x.Files + |> Seq.map (fun (file, checksum) -> file, Hex.encode checksum) + |> d.AddAll + d + + /// Computes the checksums for the list of files passed in and verifies that the pdb contains them. + /// Returns a list of matched and unmatched files and their checksums. + /// Only matches when filenames match. + member x.MatchChecksums files = + let matched = List<_>() + let unmatched = List<_>() let pdbChecksums = x.Checksums let fileChecksums = let d = Dictionary StringComparer.OrdinalIgnoreCase @@ -32,7 +58,20 @@ type PdbFile with |> Seq.map (fun (hash, file) -> Hex.encode hash, file) |> d.AddAll d - for checksum, file in pdbChecksums.KeyValues do - if fileChecksums.ContainsKey checksum = false then - missing.[file] <- checksum + + let pdbFileChecksums = x.FileChecksums + for checksum, file in fileChecksums.KeyValues do + if pdbFileChecksums.ContainsKey file then + let checksumInPdb = pdbFileChecksums.[file] + let pc = { File = file; ChecksumOfFile = checksum; ChecksumInPdb = checksumInPdb } + if checksum = checksumInPdb then + matched.Add pc + else unmatched.Add pc + { Matched = matched; Unmatched = unmatched } + + [] + member x.VerifyChecksums files = + let missing = SortedDictionary StringComparer.OrdinalIgnoreCase // file, checksum + for um in (x.MatchChecksums files).Unmatched do + missing.[um.File] <- um.ChecksumOfFile missing \ No newline at end of file diff --git a/SourceLink/SrcSrv.fs b/SourceLink/SrcSrv.fs index 2d00f31..747204d 100644 --- a/SourceLink/SrcSrv.fs +++ b/SourceLink/SrcSrv.fs @@ -10,6 +10,7 @@ module SrcSrv = let noFormatting (s: string) = s /// creates the SrcSrv with callback for formatting the path + /// paths is the list of original file system paths and their repository paths let createFormat rawUrl (commit:string) (paths:seq) (formatPath: string -> string) = use ms = new MemoryStream() use sw = new StreamWriter(ms) diff --git a/SourceLink/VsProj.fs b/SourceLink/VsProj.fs index 267dc5b..d3b384a 100644 --- a/SourceLink/VsProj.fs +++ b/SourceLink/VsProj.fs @@ -59,6 +59,7 @@ type Project with member x.OutputFilePdb with get() = Path.ChangeExtension(x.OutputFile, ".pdb") member x.OutputFilePdbSrcSrv with get() = x.OutputFilePdb + ".srcsrv" +// [] member x.VerifyPdbFiles (files:seq) = use pdb = new PdbFile(x.OutputFilePdb) pdb.VerifyChecksums files diff --git a/build.fsx b/build.fsx index b3f3b68..cf5ec51 100644 --- a/build.fsx +++ b/build.fsx @@ -69,17 +69,11 @@ Target "Build" <| fun _ -> Target "SourceLink" <| fun _ -> printfn "starting SourceLink" let sourceIndex proj pdb = - use repo = new GitRepo(__SOURCE_DIRECTORY__) let p = VsProj.LoadRelease proj -// let p = VsProj.Load proj ["Configuration","Release"; "VisualStudioVersion","12.0"] // on AppVeyor let pdbToIndex = if Option.isSome pdb then pdb.Value else p.OutputFilePdb - logfn "source indexing %s" pdbToIndex - let files = p.Compiles -- "**/AssemblyInfo.fs" - repo.VerifyChecksums files - p.VerifyPdbChecksums files - p.CreateSrcSrv "https://raw.githubusercontent.com/ctaggart/SourceLink/{0}/%var2%" repo.Commit (repo.Paths files) - Pdbstr.exec pdbToIndex p.OutputFilePdbSrcSrv - sourceIndex "Tfs/Tfs.fsproj" None + let url = "https://raw.githubusercontent.com/ctaggart/SourceLink/{0}/%var2%" + p.SourceIndex pdbToIndex p.Compiles __SOURCE_DIRECTORY__ url + sourceIndex "Tfs/Tfs.fsproj" None sourceIndex "SourceLink/SourceLink.fsproj" None sourceIndex "Git/Git.fsproj" None sourceIndex "SymbolStore/SymbolStore.fsproj" None diff --git a/build.ps1 b/build.ps1 index e71178d..c1050bc 100644 --- a/build.ps1 +++ b/build.ps1 @@ -1,3 +1,2 @@ -(Get-Item Env:\PSModulePath).Value -Split ';' Paket-Restore .\packages\FAKE\tools\FAKE.exe build.fsx @args \ No newline at end of file diff --git a/paket.dependencies b/paket.dependencies index 47eb149..efb4119 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -3,7 +3,7 @@ source https://ci.appveyor.com/nuget/sourcelink-helmesfwai2a #source https://ci.appveyor.com/nuget/msbuild-kn0ejscjf29k nuget FAKE -nuget SourceLink.Fake 0.6.0-b175 +nuget SourceLink.Fake 0.6.0-b218 nuget FSharp.Formatting nuget NuGet.CommandLine nuget RazorEngine diff --git a/paket.lock b/paket.lock index 0a9ba20..55e48d7 100644 --- a/paket.lock +++ b/paket.lock @@ -1,10 +1,10 @@ NUGET remote: http://nuget.org/api/v2 specs: - FAKE (3.31.0) - FSharp.Compiler.Service (0.0.89) + FAKE (3.35.4) + FSharp.Compiler.Service (0.0.90) FSharp.Core (3.1.2.1) - FSharp.Formatting (2.9.5) + FSharp.Formatting (2.9.10) FSharp.Compiler.Service (>= 0.0.87) FSharpVSPowerTools.Core (1.8.0) FSharpVSPowerTools.Core (1.8.0) @@ -22,4 +22,4 @@ NUGET UnionArgParser (0.8.7) remote: https://ci.appveyor.com/nuget/sourcelink-helmesfwai2a specs: - SourceLink.Fake (0.6.0-b175) + SourceLink.Fake (0.6.0-b218)