match source files > pdb > git

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()

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
+    [<Obsolete "use VsProj.SourceIndex">]
     member x.VerifyChecksums files =
         let different = x.VerifyFiles files
         if different.Length <> 0 then
@@ -47,27 +49,58 @@ 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
         // use relative paths if in workdir
         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
+        Pdbstr.execWith exe.Value pdb srcsrv
+
+type Microsoft.Build.Evaluation.Project with // VsProj
+    [<Obsolete "use VsProj.SourceIndex">]
+    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

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<GitChecksum>
+    Unmatched: List<GitChecksum> }
+
 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
+//    [<Obsolete "use .MatchChecksums instead">]
     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 =

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<PdbChecksum>
+    Unmatched: List<PdbChecksum> }
+
+    with 
+        member x.MatchedFiles =
+            x.Matched |> Seq.map (fun fc -> fc.File) |> List.ofSeq
+
 type PdbFile with
 
     member x.Files
@@ -19,20 +32,46 @@ 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
             Crypto.hashesMD5 files 
             |> 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 }
+
+    [<Obsolete "use .MatchChecksums instead">]
+    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

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<string*string>) (formatPath: string -> string) =
         use ms = new MemoryStream()
         use sw = new StreamWriter(ms)

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"
 
+//    [<Obsolete>]
     member x.VerifyPdbFiles (files:seq<string>) = 
         use pdb = new PdbFile(x.OutputFilePdb)
         pdb.VerifyChecksums files

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

build.ps1

@@ -1,3 +1,2 @@
-(Get-Item Env:\PSModulePath).Value -Split ';'
 Paket-Restore
 .\packages\FAKE\tools\FAKE.exe build.fsx @args

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

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)