diff --git a/help/pics/teamcity/loghierarchy.png b/help/pics/teamcity/loghierarchy.png new file mode 100644 index 00000000000..6af7bf4d5b7 Binary files /dev/null and b/help/pics/teamcity/loghierarchy.png differ diff --git a/help/pics/teamcity/loghierarchy2.png b/help/pics/teamcity/loghierarchy2.png new file mode 100644 index 00000000000..27667f2686d Binary files /dev/null and b/help/pics/teamcity/loghierarchy2.png differ diff --git a/help/pics/teamcity/versionnumber.png b/help/pics/teamcity/versionnumber.png new file mode 100644 index 00000000000..4064a0e6688 Binary files /dev/null and b/help/pics/teamcity/versionnumber.png differ diff --git a/help/pics/teamcity/versionnumber2.png b/help/pics/teamcity/versionnumber2.png new file mode 100644 index 00000000000..3f756b62ba6 Binary files /dev/null and b/help/pics/teamcity/versionnumber2.png differ diff --git a/help/teamcityadvanced.md b/help/teamcityadvanced.md new file mode 100644 index 00000000000..fbcd38c2c9c --- /dev/null +++ b/help/teamcityadvanced.md @@ -0,0 +1,106 @@ +# Advanced TeamCity usage + +As can be seen on the [TeamCity](teamcity.md) page FAKE is really easy to setup in TeamCity, +it also support some advanced scenarios to integrate even deeper with it. + +## Displaying blocks in the log + +By default each Target already is displayed as a collapsible block in the log file : + +![Target blocks](pics/teamcity/loghierarchy.png "Target blocks") + +But blocks can be created in targets to separate operations more +cleanly : + +```fsharp +let printHello name = + use __ = teamCityBlock (sprintf "Hello %s" name) + printfn "Hello %s !" name + +Target "Default" (fun () -> + printHello "Fake" + printHello "TeamCity" +) +``` +![Custom blocks](pics/teamcity/loghierarchy2.png "Custom blocks") + +## Reporting artifacts + +While TeamCity has a [great configurability](https://confluence.jetbrains.com/display/TCD10/Build+Artifact) +in terms of artifacts, nothing beats specifying them in code. + +FAKE scripts also have the advantage of being versioned along the rest of your code, avoiding the need to +keep complex artifact configurations when you need to support a new branch along with old ones or the need +to configure artifacts in each build if you have multiple builds on the same repository. + +```fsharp +Target "NuGet" (fun () -> + Paket.Pack (fun p -> { p with OutputPath = "." }) + + !! "*.nupkg" + |> Seq.iter(PublishArtifact) +) +``` + +## Customizing version numbers + +Each build is assigned a build number in TeamCity that is available as `TeamCityBuildNumber` from FAKE +and that is shown in the TeamCity dashboard : + +![Default version numbers](pics/teamcity/versionnumber.png "Default version numbers") + +But TeamCity also support that builds customize their version number by reporting it directly, using this +feature from FAKE is simple and when coupled with other parameters reported by TeamCity can allow complex +versioning schemes. + +This code read versions from a release notes file and if TeamCity is detected label versions as pre-release +when they come from a branch that isn't the default one or from a personal build : + +```fsharp +// Placed outside any Target +let releaseNotes = + let fromFile = ReleaseNotesHelper.LoadReleaseNotes ("Release Notes.md") + if buildServer = TeamCity then + let buildNumber = int (defaultArg TeamCityBuildNumber "0") + let asmVer = System.Version.Parse(fromFile.AssemblyVersion) + let asmVer = System.Version(asmVer.Major, asmVer.Minor, buildNumber) + let prerelease = + if TeamCityBuildIsPersonal then "-personal" + else if getTeamCityBranchIsDefault () then "" else "-branch" + let nugetVersion = asmVer.ToString() + prerelease + + ReleaseNotesHelper.ReleaseNotes.New(asmVer.ToString(), nugetVersion, fromFile.Date, fromFile.Notes) + else + fromFile + +SetBuildNumber releaseNotes.NugetVersion +``` + +![Custom version numbers](pics/teamcity/versionnumber2.png "Custom version numbers") + +## Reporting test results + +In addition to artifacts, TeamCity also allow to report test results that will be +visible in the dashboard directly from the build. + +Each test runner has a specific function to send it's result that can be found in the +[TeamCityHelper API](apidocs/fake-teamcityhelper.html) like here for NUnit : + +```fsharp +Target "Tests" (fun () -> + testDlls + |> NUnit(fun p -> + { p with + OutputFile = outputFile + // If the build fails immediately the + // test results will never be reported + ErrorLevel = DontFailBuild + }) + + sendTeamCityNUnitImport outputFile +) +``` + +*Note:* NUnit version 3 is a special case as it directly support TeamCity and it's +enough to set `TeamCity = (BuildServer = TeamCity)` in +[it's configuration](apidocs/fake-testing-nunit3-nunit3params.html). diff --git a/help/templates/template.cshtml b/help/templates/template.cshtml index 2716d50ecd2..3d2d3ee50b5 100644 --- a/help/templates/template.cshtml +++ b/help/templates/template.cshtml @@ -69,6 +69,7 @@
  • Creating custom tasks
  • Soft dependencies
  • TeamCity integration
    • +
  • TeamCity integration (Advanced)
  • Running canopy tests
  • Octopus Deploy
  • TypeScript support
    • diff --git a/src/app/FakeLib/TeamCityHelper.fs b/src/app/FakeLib/TeamCityHelper.fs index 99b9a292441..f26350ae131 100644 --- a/src/app/FakeLib/TeamCityHelper.fs +++ b/src/app/FakeLib/TeamCityHelper.fs @@ -3,7 +3,7 @@ module Fake.TeamCityHelper /// Encapsulates special chars -let inline EncapsulateSpecialChars text = +let inline EncapsulateSpecialChars text = text |> replace "|" "||" |> replace "'" "|'" @@ -15,15 +15,15 @@ let inline EncapsulateSpecialChars text = let scrub = RemoveLineBreaks >> EncapsulateSpecialChars /// Send message to TeamCity -let sendToTeamCity format message = - if buildServer = TeamCity then +let sendToTeamCity format message = + if buildServer = TeamCity then message |> scrub |> sprintf format |> fun m -> postMessage (LogMessage(m, true)) /// Send message to TeamCity -let sendStrToTeamCity s = +let sendStrToTeamCity s = if buildServer = TeamCity then postMessage (LogMessage(RemoveLineBreaks s, true)) /// Open Named Block @@ -32,120 +32,127 @@ let sendOpenBlock = sendToTeamCity "##teamcity[blockOpened name='%s']" /// Close Named Block let sendCloseBlock = sendToTeamCity "##teamcity[blockClosed name='%s']" +/// Open Named Block that will be closed when the block is disposed +/// Usage: `use __ = teamCityBlock "My Block"` +let teamCityBlock name = + sendOpenBlock name + { new System.IDisposable + with member __.Dispose() = sendCloseBlock name } + /// Sends an error to TeamCity let sendTeamCityError error = sendToTeamCity "##teamcity[buildStatus status='FAILURE' text='%s']" error /// Sends an NUnit results filename to TeamCity let sendTeamCityNUnitImport path = sendToTeamCity "##teamcity[importData type='nunit' file='%s']" path -/// Sends an FXCop results filename to TeamCity +/// Sends an FXCop results filename to TeamCity let sendTeamCityFXCopImport path = sendToTeamCity "##teamcity[importData type='FxCop' path='%s']" path -/// Sends an JUnit Ant task results filename to TeamCity +/// Sends an JUnit Ant task results filename to TeamCity let sendTeamCityJUnitImport path = sendToTeamCity "##teamcity[importData type='junit' path='%s']" path -/// Sends an Maven Surefire results filename to TeamCity +/// Sends an Maven Surefire results filename to TeamCity let sendTeamCitySurefireImport path = sendToTeamCity "##teamcity[importData type='surefire' path='%s']" path -/// Sends an MSTest results filename to TeamCity +/// Sends an MSTest results filename to TeamCity let sendTeamCityMSTestImport path = sendToTeamCity "##teamcity[importData type='mstest' path='%s']" path -/// Sends an Google Test results filename to TeamCity +/// Sends an Google Test results filename to TeamCity let sendTeamCityGTestImport path = sendToTeamCity "##teamcity[importData type='gtest' path='%s']" path -/// Sends an Checkstyle results filename to TeamCity +/// Sends an Checkstyle results filename to TeamCity let sendTeamCityCheckstyleImport path = sendToTeamCity "##teamcity[importData type='checkstyle' path='%s']" path -/// Sends an FindBugs results filename to TeamCity +/// Sends an FindBugs results filename to TeamCity let sendTeamCityFindBugsImport path = sendToTeamCity "##teamcity[importData type='findBugs' path='%s']" path -/// Sends an JSLint results filename to TeamCity +/// Sends an JSLint results filename to TeamCity let sendTeamCityJSLintImport path = sendToTeamCity "##teamcity[importData type='jslint' path='%s']" path -/// Sends an ReSharper inspectCode.exe results filename to TeamCity +/// Sends an ReSharper inspectCode.exe results filename to TeamCity let sendTeamCityReSharperInspectCodeImport path = sendToTeamCity "##teamcity[importData type='ReSharperInspectCode' path='%s']" path -/// Sends an FxCop inspection results filename to TeamCity +/// Sends an FxCop inspection results filename to TeamCity let sendTeamCityFxCopImport path = sendToTeamCity "##teamcity[importData type='FxCop' path='%s']" path -/// Sends an PMD inspections results filename to TeamCity +/// Sends an PMD inspections results filename to TeamCity let sendTeamCityPmdImport path = sendToTeamCity "##teamcity[importData type='pmd' path='%s']" path -/// Sends an PMD Copy/Paste Detector results filename to TeamCity +/// Sends an PMD Copy/Paste Detector results filename to TeamCity let sendTeamCityPmdCpdImport path = sendToTeamCity "##teamcity[importData type='pmdCpd' path='%s']" path -/// Sends an ReSharper dupfinder.exe results filename to TeamCity +/// Sends an ReSharper dupfinder.exe results filename to TeamCity let sendTeamCityDotNetDupFinderImport path = sendToTeamCity "##teamcity[importData type='DotNetDupFinder' path='%s']" path -/// Sends an dotcover, partcover, ncover or ncover3 results filename to TeamCity +/// Sends an dotcover, partcover, ncover or ncover3 results filename to TeamCity [] let sendTeamCityDotNetCoverageImport path = sendToTeamCity "##teamcity[importData type='dotNetCoverage' path='%s']" path type TeamCityDotNetCoverageTool = | DotCover | PartCover | NCover | NCover3 with override x.ToString() = match x with | DotCover -> "dotcover" | PartCover -> "partcover" | NCover -> "ncover" | NCover3 -> "ncover3" -/// Sends an dotcover, partcover, ncover or ncover3 results filename to TeamCity -let sendTeamCityDotNetCoverageImportForTool path (tool : TeamCityDotNetCoverageTool) = +/// Sends an dotcover, partcover, ncover or ncover3 results filename to TeamCity +let sendTeamCityDotNetCoverageImportForTool path (tool : TeamCityDotNetCoverageTool) = sprintf "##teamcity[importData type='dotNetCoverage' tool='%s' path='%s']" (string tool |> scrub) (path |> scrub) |> sendStrToTeamCity /// Sends the full path to the dotCover home folder to override the bundled dotCover to TeamCity let sendTeamCityDotCoverHome = sendToTeamCity "##teamcity[dotNetCoverage dotcover_home='%s']" - + /// Sends the full path to NCover installation folder to TeamCity let sendTeamCityNCover3Home = sendToTeamCity "##teamcity[dotNetCoverage ncover3_home='%s']" /// Sends arguments for the NCover report generator to TeamCity let sendTeamCityNCover3ReporterArgs = sendToTeamCity "##teamcity[dotNetCoverage ncover3_reporter_args='%s']" - + /// Sends the path to NCoverExplorer to TeamCity let sendTeamCityNCoverExplorerTool = sendToTeamCity "##teamcity[dotNetCoverage ncover_explorer_tool='%s']" - + /// Sends additional arguments for NCover 1.x to TeamCity let sendTeamCityNCoverExplorerToolArgs = sendToTeamCity "##teamcity[dotNetCoverage ncover_explorer_tool_args='%s']" - + /// Sends the value for NCover /report: argument to TeamCity let sendTeamCityNCoverReportType : int -> unit = string >> sendToTeamCity "##teamcity[dotNetCoverage ncover_explorer_report_type='%s']" - + /// Sends the value for NCover /sort: argument to TeamCity let sendTeamCityNCoverReportOrder : int -> unit = string >> sendToTeamCity "##teamcity[dotNetCoverage ncover_explorer_report_order='%s']" - + /// Send the PartCover xslt transformation rules (Input xlst and output files) to TeamCity let sendTeamCityPartCoverReportXslts : seq -> unit = Seq.map (fun (xslt, output) -> sprintf "%s=>%s" xslt output) >> Seq.map EncapsulateSpecialChars >> String.concat "|n" >> sprintf "##teamcity[dotNetCoverage partcover_report_xslts='%s']" - >> sendStrToTeamCity + >> sendStrToTeamCity /// Starts the test case. -let StartTestCase testCaseName = +let StartTestCase testCaseName = sendToTeamCity "##teamcity[testStarted name='%s' captureStandardOutput='true']" testCaseName /// Finishes the test case. -let FinishTestCase testCaseName (duration : System.TimeSpan) = - let duration = +let FinishTestCase testCaseName (duration : System.TimeSpan) = + let duration = duration.TotalMilliseconds |> round |> string - sprintf "##teamcity[testFinished name='%s' duration='%s']" (EncapsulateSpecialChars testCaseName) duration + sprintf "##teamcity[testFinished name='%s' duration='%s']" (EncapsulateSpecialChars testCaseName) duration |> sendStrToTeamCity -/// Ignores the test case. -let IgnoreTestCase name message = +/// Ignores the test case. +let IgnoreTestCase name message = StartTestCase name - sprintf "##teamcity[testIgnored name='%s' message='%s']" (EncapsulateSpecialChars name) + sprintf "##teamcity[testIgnored name='%s' message='%s']" (EncapsulateSpecialChars name) (EncapsulateSpecialChars message) |> sendStrToTeamCity -/// Ignores the test case. -let IgnoreTestCaseWithDetails name message details = +/// Ignores the test case. +let IgnoreTestCaseWithDetails name message details = IgnoreTestCase name (message + " " + details) /// Finishes the test suite. -let FinishTestSuite testSuiteName = +let FinishTestSuite testSuiteName = EncapsulateSpecialChars testSuiteName |> sendToTeamCity "##teamcity[testSuiteFinished name='%s']" /// Starts the test suite. -let StartTestSuite testSuiteName = +let StartTestSuite testSuiteName = EncapsulateSpecialChars testSuiteName |> sendToTeamCity "##teamcity[testSuiteStarted name='%s']" /// Reports the progress. @@ -159,7 +166,7 @@ let ReportProgressFinish message = EncapsulateSpecialChars message |> sendToTeam /// Create the build status. /// [omit] -let buildStatus status message = +let buildStatus status message = sprintf "##teamcity[buildStatus '%s' text='%s']" (EncapsulateSpecialChars status) (EncapsulateSpecialChars message) /// Reports the build status. @@ -175,33 +182,27 @@ let PublishArticfact path = PublishArtifact path let SetBuildNumber buildNumber = EncapsulateSpecialChars buildNumber |> sendToTeamCity "##teamcity[buildNumber '%s']" /// Reports a build statistic. -let SetBuildStatistic key value = - sprintf "##teamcity[buildStatisticValue key='%s' value='%s']" (EncapsulateSpecialChars key) +let SetBuildStatistic key value = + sprintf "##teamcity[buildStatisticValue key='%s' value='%s']" (EncapsulateSpecialChars key) (EncapsulateSpecialChars value) |> sendStrToTeamCity /// Reports a parameter value -let SetTeamCityParameter name value = - sprintf "##teamcity[setParameter name='%s' value='%s']" (EncapsulateSpecialChars name) +let SetTeamCityParameter name value = + sprintf "##teamcity[setParameter name='%s' value='%s']" (EncapsulateSpecialChars name) (EncapsulateSpecialChars value) |> sendStrToTeamCity /// Reports a failed test. -let TestFailed name message details = - sprintf "##teamcity[testFailed name='%s' message='%s' details='%s']" (EncapsulateSpecialChars name) +let TestFailed name message details = + sprintf "##teamcity[testFailed name='%s' message='%s' details='%s']" (EncapsulateSpecialChars name) (EncapsulateSpecialChars message) (EncapsulateSpecialChars details) |> sendStrToTeamCity /// Reports a failed comparison. -let ComparisonFailure name message details expected actual = - sprintf - "##teamcity[testFailed type='comparisonFailure' name='%s' message='%s' details='%s' expected='%s' actual='%s']" - (EncapsulateSpecialChars name) (EncapsulateSpecialChars message) (EncapsulateSpecialChars details) +let ComparisonFailure name message details expected actual = + sprintf + "##teamcity[testFailed type='comparisonFailure' name='%s' message='%s' details='%s' expected='%s' actual='%s']" + (EncapsulateSpecialChars name) (EncapsulateSpecialChars message) (EncapsulateSpecialChars details) (EncapsulateSpecialChars expected) (EncapsulateSpecialChars actual) |> sendStrToTeamCity -/// Gets the recently failed tests -let getRecentlyFailedTests() = appSetting "teamcity.tests.recentlyFailedTests.file" |> ReadFile - -/// Gets the changed files -let getChangedFilesInCurrentBuild() = appSetting "teamcity.build.changedFiles.file" |> ReadFile - /// The Version of the TeamCity server. This property can be used to determine the build is run within TeamCity. let TeamCityVersion = environVarOrNone "TEAMCITY_VERSION" @@ -212,10 +213,334 @@ let TeamCityProjectName = environVarOrNone "TEAMCITY_PROJECT_NAME" let TeamCityBuildConfigurationName = environVarOrNone "TEAMCITY_BUILDCONF_NAME" /// Is set to true if the build is a personal one. -let TeamCityBuildIsPersonal = +let TeamCityBuildIsPersonal = match environVarOrNone "BUILD_IS_PERSONAL" with | Some _ -> true | None -> false /// The Build number assigned to the build by TeamCity using the build number format or None if it's not on TeamCity. let TeamCityBuildNumber = environVarOrNone "BUILD_NUMBER" + +module private JavaPropertiesFile = + open System.Text + open System.IO + open System.Globalization + + type PropertiesFileEntry = + | Comment of text : string + | KeyValue of key : string * value : string + + module private Parser = + type CharReader = unit -> char option + + let inline (|IsWhitespace|_|) c = + match c with + | Some c -> if c = ' ' || c = '\t' || c = '\u00ff' then Some c else None + | None -> None + + type IsEof = + | Yes = 1y + | No = 0y + + let rec readToFirstChar (c: char option) (reader: CharReader) = + match c with + | IsWhitespace _ -> + readToFirstChar (reader ()) reader + | Some '\r' + | Some '\n' -> + None, IsEof.No + | Some _ -> c, IsEof.No + | None -> None, IsEof.Yes + + let inline (|EscapeSequence|_|) c = + match c with + | Some c -> + if c = 'r' || c = 'n' || c = 'u' || c = 'f' || c = 't' || c = '"' || c = ''' || c = '\\' then + Some c + else + None + | None -> None + + let inline isHex c = (c >= '0' && c <= '9') || (c >= 'A' && c <= 'F') || (c >= 'a' && c <= 'f') + + let readEscapeSequence (c: char) (reader: CharReader) = + match c with + | 'r' -> '\r' + | 'n' -> '\n' + | 'f' -> '\f' + | 't' -> '\t' + | 'u' -> + match reader(), reader(), reader(), reader() with + | Some c1, Some c2, Some c3, Some c4 when isHex c1 && isHex c2 && isHex c3 && isHex c4 -> + let hex = System.String([|c1;c2;c3;c4|]) + let value = System.UInt16.Parse(hex, NumberStyles.AllowHexSpecifier, CultureInfo.InvariantCulture) + char value + | _ -> + failwith "Invalid unicode escape" + | _ -> c + + let inline readKey (c: char option) (reader: CharReader) (buffer: StringBuilder) = + let rec recurseEnd (result: string) = + match reader () with + | Some ':' + | Some '=' + | IsWhitespace _ -> recurseEnd result + | Some '\r' + | Some '\n' -> result, false, None, IsEof.No + | None -> result, false, None, IsEof.Yes + | Some c -> result, true, Some c, IsEof.No + let rec recurse (c: char option) (buffer: StringBuilder) (escaping: bool) = + match c with + | EscapeSequence c when escaping -> + let realChar = readEscapeSequence c reader + recurse (reader()) (buffer.Append(realChar)) false + | Some ' ' -> recurseEnd (buffer.ToString()) + | Some ':' + | Some '=' when not escaping -> recurseEnd (buffer.ToString()) + | Some '\r' + | Some '\n' -> buffer.ToString(), false, None, IsEof.No + | None -> buffer.ToString(), false, None, IsEof.Yes + | Some '\\' -> recurse (reader ()) buffer true + | Some c -> recurse (reader ()) (buffer.Append(c)) false + + recurse c buffer false + + let rec readComment (reader: CharReader) (buffer: StringBuilder) = + match reader () with + | Some '\r' + | Some '\n' -> + Some (Comment (buffer.ToString())), IsEof.No + | None -> + Some(Comment (buffer.ToString())), IsEof.Yes + | Some c -> + readComment reader (buffer.Append(c)) + + let inline readValue (c: char option) (reader: CharReader) (buffer: StringBuilder) = + let rec recurse (c: char option) (buffer: StringBuilder) (escaping: bool) (cr: bool) (lineStart: bool) = + match c with + | EscapeSequence c when escaping -> + let realChar = readEscapeSequence c reader + recurse (reader()) (buffer.Append(realChar)) false false false + | Some '\r' + | Some '\n' -> + if escaping || (cr && c = Some '\n') then + recurse (reader ()) buffer false (c = Some '\r') true + else + buffer.ToString(), IsEof.No + | None -> + buffer.ToString(), IsEof.Yes + | Some _ when lineStart -> + let firstChar, _ = readToFirstChar c reader + recurse firstChar buffer false false false + | Some '\\' -> recurse (reader ()) buffer true false false + | Some c -> + recurse (reader()) (buffer.Append(c)) false false false + + recurse c buffer false false true + + let rec readLine (reader: CharReader) (buffer: StringBuilder) = + match readToFirstChar (reader ()) reader with + | Some '#', _ + | Some '!', _ -> + readComment reader (buffer.Clear()) + | Some firstChar, _ -> + let key, hasValue, c, isEof = readKey (Some firstChar) reader (buffer.Clear()) + let value, isEof = + if hasValue then + // We know that we aren't at the end of the buffer, but readKey can return None if it didn't need the next char + let firstChar = match c with | Some c -> Some c | None -> reader () + readValue firstChar reader (buffer.Clear()) + else + "", isEof + Some (KeyValue(key, value)), isEof + | None, isEof -> None, isEof + + let inline textReaderToReader (reader: TextReader) = + let buffer = [| '\u0000' |] + fun () -> + let eof = reader.Read(buffer, 0, 1) = 0 + if eof then None else Some (buffer.[0]) + + let parseWithReader reader = + let buffer = StringBuilder(255) + let mutable isEof = IsEof.No + + seq { + while isEof <> IsEof.Yes do + let line, isEofAfterLine = readLine reader buffer + match line with + | Some line -> yield line + | None -> () + isEof <- isEofAfterLine + } + + let parseTextReader (reader: TextReader) = + let reader = Parser.textReaderToReader reader + Parser.parseWithReader reader + +/// TeamCity build parameters +/// See [Predefined Build Parameters documentation](https://confluence.jetbrains.com/display/TCD10/Predefined+Build+Parameters) for more information +module TeamCityBuildParameters = + open System + open System.IO + + let private get (fileName: string option) = + match fileName with + | Some fileName when (fileName <> null) && (fileExists fileName) -> + use stream = File.OpenRead(fileName) + use reader = new StreamReader(stream) + + reader + |> JavaPropertiesFile.parseTextReader + |> Seq.choose(function + | JavaPropertiesFile.Comment _ -> None + | JavaPropertiesFile.KeyValue(k, v) -> Some (k,v)) + |> Map.ofSeq + | _ -> + Map.empty + + let private systemFile = Environment.GetEnvironmentVariable("TEAMCITY_BUILD_PROPERTIES_FILE") + let private system = lazy(get (Some systemFile)) + + /// Get all system parameters + let getAllSystem () = system.Value + + /// Get the value of a system parameter by name + let tryGetSystem name = system.Value |> Map.tryFind name + + let private configurationFile = lazy (tryGetSystem "teamcity.configuration.properties.file") + let private configuration = lazy (get configurationFile.Value) + + /// Get all configuration parameters + let getAllConfiguration () = configuration.Value + + /// Get the value of a configuration parameter by name + let tryGetConfiguration name = configuration.Value |> Map.tryFind name + + let private runnerFile = lazy (tryGetSystem "teamcity.runner.properties.file") + let private runner = lazy (get runnerFile.Value) + + /// Get all runner parameters + let getAllRunner () = runner.Value + + /// Get the value of a runner parameter by name + let tryGetRunner name = runner.Value |> Map.tryFind name + + let private all = lazy ( + if buildServer = TeamCity then + seq { + // Environment variables are available using 'env.foo' syntax in TeamCity configuration + for pair in System.Environment.GetEnvironmentVariables() do + let pair = pair :?> System.Collections.DictionaryEntry + let key = pair.Key :?> string + let value = pair.Value :?> string + yield sprintf "env.%s" key, value + + // Runner variables aren't available in TeamCity configuration so we choose an arbitrary syntax of 'runner.foo' + for pair in runner.Value do yield sprintf "runner.%s" pair.Key, pair.Value + + // System variables are prefixed with 'system.' as in TeamCity configuration + for pair in system.Value do yield sprintf "system.%s" pair.Key, pair.Value + + for pair in configuration.Value do yield pair.Key, pair.Value + } + |> Map.ofSeq + else + Map.empty) + + /// Get all parameters + /// System ones are prefixed with 'system.', runner ones with 'runner.' and environment variables with 'env.' + let getAll () = all.Value + + /// Get the value of a parameter by name + /// System ones are prefixed with 'system.', runner ones with 'runner.' and environment variables with 'env.' + let tryGet name = all.Value |> Map.tryFind name + +/// Get files changed between builds in TeamCity +module TeamCityChangedFiles = + /// The type of change that occured + type ModificationType = + | FileChanged + | FileAdded + | FileRemoved + | FileNotChanged + | DirectoryChanged + | DirectoryAdded + | DirectoryRemoved + + /// Describe a change between builds + type FileChange = { + /// Path of the file that changed, relative to the current checkout directory ('system.teamcity.build.checkoutDir') + filePath: string + /// Type of modification for the file + modificationType: ModificationType + /// + revision: string option } + + let private getFileChanges' () = + match TeamCityBuildParameters.tryGetSystem "teamcity.build.changedFiles.file" with + | Some file when fileExists file -> + Some [ + for line in ReadFile file do + let split = line.Split(':') + if split.Length = 3 then + let filePath = split.[0] + let modificationType = + match split.[1].ToUpperInvariant() with + | "CHANGED" -> FileChanged + | "ADDED" -> FileAdded + | "REMOVED" -> FileRemoved + | "NOT_CHANGED" -> FileNotChanged + | "DIRECTORY_CHANGED" -> DirectoryChanged + | "DIRECTORY_ADDED" -> DirectoryAdded + | "DIRECTORY_REMOVED" -> DirectoryRemoved + | _ -> failwithf "Unknown change type: %s" (split.[1]) + let revision = + match split.[2] with + | "" -> None + | revision -> Some revision + + yield { filePath = filePath; modificationType = modificationType; revision = revision } + else + failwithf "Unable to split change line: %s" line + ] + | _ -> None + + let private fileChanges = lazy (getFileChanges' ()) + + /// Changed files (since previous build) that are included in this build + /// See [the documentation](https://confluence.jetbrains.com/display/TCD10/Risk+Tests+Reordering+in+Custom+Test+Runner) for more information + let get () = fileChanges.Value + +let private getRecentlyFailedTests' () = + match TeamCityBuildParameters.tryGetSystem "teamcity.tests.recentlyFailedTests.file" with + | Some file when fileExists file -> Some(ReadFile file) + | _ -> None + +let private recentlyFailedTests = lazy (getRecentlyFailedTests' ()) + +/// Name of recently failing tests +/// See [the documentation](https://confluence.jetbrains.com/display/TCD10/Risk+Tests+Reordering+in+Custom+Test+Runner) for more information +let getTeamCityRecentlyFailedTests () = recentlyFailedTests.Value + +/// Get the branch of the main VCS root +let getTeamCityBranch () = TeamCityBuildParameters.tryGetConfiguration "vcsroot.branch" + +/// Get the display name of the branch as shown in TeamCity +/// See [the documentation](https://confluence.jetbrains.com/display/TCD10/Working+with+Feature+Branches#WorkingwithFeatureBranches-branchSpec) for more information +let getTeamCityBranchName () = + match TeamCityBuildParameters.tryGetConfiguration "teamcity.build.branch" with + | Some _ as branch -> branch + | None -> TeamCityBuildParameters.tryGetConfiguration "vcsroot.branch" + +/// Get if the current branch is the one configured as default +let getTeamCityBranchIsDefault () = + if buildServer = TeamCity then + match TeamCityBuildParameters.tryGetConfiguration "teamcity.build.branch.is_default" with + | Some "true" -> true + | Some _ -> false + | None -> + // When only one branch is configured, TeamCity doesn't emit this parameter + getTeamCityBranch().IsSome + else + false diff --git a/src/app/FakeLib/TeamCityRESTHelper.fs b/src/app/FakeLib/TeamCityRESTHelper.fs index 7379fa95840..75b9fde5b97 100644 --- a/src/app/FakeLib/TeamCityRESTHelper.fs +++ b/src/app/FakeLib/TeamCityRESTHelper.fs @@ -6,27 +6,27 @@ module Fake.TeamCityRESTHelper let prepareURL restURL (serverURL : string) = serverURL.Trim '/' + restURL /// Returns the REST version of the TeamCity server -let getRESTVersion serverURL username password = +let getRESTVersion serverURL username password = serverURL |> prepareURL "/httpAuth/app/rest/version" |> REST.ExecuteGetCommand username password /// Record type which stores VCSRoot properties -type VCSRoot = +type VCSRoot = { URL : string Properties : Map VCSName : string Name : string } /// Record type which stores Build properties -type Build = +type Build = { ID : string Number : string Status : string WebURL : string } /// Record type which stores Build configuration properties -type BuildConfiguration = +type BuildConfiguration = { ID : string Name : string WebURL : string @@ -36,7 +36,7 @@ type BuildConfiguration = Builds : Build seq } /// Record type which stores TeamCity project properties -type Project = +type Project = { ID : string Name : string Description : string @@ -45,40 +45,44 @@ type Project = BuildConfigs : string seq } /// [omit] -let getFirstNode serverURL username password url = +let getFirstNode serverURL username password url = serverURL |> prepareURL url |> REST.ExecuteGetCommand username password |> XMLDoc |> DocElement +let private parseBooleanOrFalse s = + let ok, parsed = System.Boolean.TryParse s + if ok then parsed else false + /// Gets information about a build configuration from the TeamCity server. -let getBuildConfig serverURL username password id = +let getBuildConfig serverURL username password id = sprintf "/httpAuth/app/rest/buildTypes/id:%s" id |> getFirstNode serverURL username password - |> parse "buildType" (fun n -> + |> parse "buildType" (fun n -> { ID = getAttribute "id" n Name = getAttribute "name" n Description = getAttribute "description" n WebURL = getAttribute "webUrl" n - Paused = getAttribute "paused" n |> System.Boolean.Parse + Paused = getAttribute "paused" n |> parseBooleanOrFalse ProjectID = parseSubNode "project" (getAttribute "id") n Builds = [] }) /// Gets informnation about a project from the TeamCity server. -let getProject serverURL username password id = +let getProject serverURL username password id = sprintf "/httpAuth/app/rest/projects/id:%s" id |> getFirstNode serverURL username password - |> parse "project" (fun n -> + |> parse "project" (fun n -> { ID = getAttribute "id" n Name = getAttribute "name" n Description = getAttribute "description" n WebURL = getAttribute "webUrl" n - Archived = getAttribute "archived" n |> System.Boolean.Parse + Archived = getAttribute "archived" n |> parseBooleanOrFalse BuildConfigs = parseSubNode "buildTypes" getChilds n |> Seq.map (getAttribute "id") }) /// Gets all projects on the TeamCity server. -let getProjects serverURL username password = +let getProjects serverURL username password = getFirstNode serverURL username password "/httpAuth/app/rest/projects" |> parse "projects" getChilds |> Seq.map (getAttribute "id") diff --git a/src/app/FakeLib/XMLHelper.fs b/src/app/FakeLib/XMLHelper.fs index ad98dc5081b..45948f400ad 100644 --- a/src/app/FakeLib/XMLHelper.fs +++ b/src/app/FakeLib/XMLHelper.fs @@ -11,88 +11,90 @@ open System.Xml.XPath open System.Xml.Xsl /// Reads a value from a XML document using a XPath -let XMLRead failOnError (xmlFileName : string) nameSpace prefix xPath = - try +let XMLRead failOnError (xmlFileName : string) nameSpace prefix xPath = + try let document = new XPathDocument(xmlFileName) let navigator = document.CreateNavigator() let manager = new XmlNamespaceManager(navigator.NameTable) if prefix <> "" && nameSpace <> "" then manager.AddNamespace(prefix, nameSpace) let expression = XPathExpression.Compile(xPath, manager) - seq { + seq { match expression.ReturnType with - | XPathResultType.Number | XPathResultType.Boolean | XPathResultType.String -> + | XPathResultType.Number | XPathResultType.Boolean | XPathResultType.String -> yield navigator.Evaluate(expression).ToString() - | XPathResultType.NodeSet -> + | XPathResultType.NodeSet -> let nodes = navigator.Select(expression) while nodes.MoveNext() do yield nodes.Current.Value | _ -> failwith <| sprintf "XPath-Expression return type %A not implemented" expression.ReturnType } - with exn -> + with exn -> if failOnError then failwithf "XMLRead error:\n%s" exn.Message else Seq.empty /// Reads a value from a XML document using a XPath /// Returns if the value is an int and the value -let XMLRead_Int failOnError xmlFileName nameSpace prefix xPath = - let headOrDefault def seq = +let XMLRead_Int failOnError xmlFileName nameSpace prefix xPath = + let headOrDefault def seq = if Seq.isEmpty seq then def else Seq.head seq XMLRead failOnError xmlFileName nameSpace prefix xPath |> Seq.map Int32.TryParse - |> (fun seq -> + |> (fun seq -> if failOnError then Seq.head seq else headOrDefault (false, 0) seq) /// Creates a XmlWriter which writes to the given file name -let XmlWriter(fileName : string) = +let XmlWriter(fileName : string) = let writer = new XmlTextWriter(fileName, null) writer.WriteStartDocument() writer /// Writes an XML comment to the given XmlTextWriter -let XmlComment comment (writer : XmlTextWriter) = +let XmlComment comment (writer : XmlTextWriter) = writer.WriteComment comment writer /// Writes an XML start element to the given XmlTextWriter -let XmlStartElement name (writer : XmlTextWriter) = +let XmlStartElement name (writer : XmlTextWriter) = writer.WriteStartElement name writer /// Writes an XML end element to the given XmlTextWriter -let XmlEndElement(writer : XmlTextWriter) = +let XmlEndElement(writer : XmlTextWriter) = writer.WriteEndElement() writer /// Writes an XML attribute to current element of the given XmlTextWriter -let XmlAttribute name value (writer : XmlTextWriter) = +let XmlAttribute name value (writer : XmlTextWriter) = writer.WriteAttributeString(name, value.ToString()) writer /// Writes an CData element to the given XmlTextWriter -let XmlCDataElement elementName data (writer : XmlTextWriter) = +let XmlCDataElement elementName data (writer : XmlTextWriter) = XmlStartElement elementName writer |> ignore writer.WriteCData data XmlEndElement writer /// Gets the attribute with the given name from the given XmlNode -let getAttribute (name : string) (node : #XmlNode) = node.Attributes.[name].Value +let getAttribute (name : string) (node : #XmlNode) = + let attribute = node.Attributes.[name] + if attribute <> null then attribute.Value else null /// Gets a sequence of all child nodes for the given XmlNode -let getChilds (node : #XmlNode) = - seq { +let getChilds (node : #XmlNode) = + seq { for x in node.ChildNodes -> x } /// Gets the first sub node with the given name from the given XmlNode -let getSubNode name node = +let getSubNode name node = getChilds node |> Seq.filter (fun x -> x.Name = name) |> Seq.head /// Parses a XmlNode -let parse name f (node : #XmlNode) = +let parse name f (node : #XmlNode) = if node.Name = name then f node else failwithf "Could not parse %s - Node was %s" name node.Name @@ -100,9 +102,9 @@ let parse name f (node : #XmlNode) = let parseSubNode name f = getSubNode name >> parse name f /// Loads the given text into a XmlDocument -let XMLDoc text = +let XMLDoc text = if isNullOrEmpty text then null - else + else let xmlDocument = new XmlDocument() xmlDocument.LoadXml text xmlDocument @@ -111,23 +113,23 @@ let XMLDoc text = let DocElement(doc : XmlDocument) = doc.DocumentElement /// Replaces text in the XML document specified by a XPath expression. -let XPathReplace xpath value (doc : XmlDocument) = +let XPathReplace xpath value (doc : XmlDocument) = let node = doc.SelectSingleNode xpath if node = null then failwithf "XML node '%s' not found" xpath - else + else node.Value <- value doc /// Replaces the inner text of an xml node in the XML document specified by a XPath expression. -let XPathReplaceInnerText xpath innerTextValue (doc : XmlDocument) = +let XPathReplaceInnerText xpath innerTextValue (doc : XmlDocument) = let node = doc.SelectSingleNode xpath if node = null then failwithf "XML node '%s' not found" xpath - else + else node.InnerText <- innerTextValue doc /// Selects a xml node value via XPath from the given document -let XPathValue xpath (namespaces : #seq) (doc : XmlDocument) = +let XPathValue xpath (namespaces : #seq) (doc : XmlDocument) = let nsmgr = XmlNamespaceManager(doc.NameTable) namespaces |> Seq.iter nsmgr.AddNamespace let node = doc.DocumentElement.SelectSingleNode(xpath, nsmgr) @@ -135,63 +137,63 @@ let XPathValue xpath (namespaces : #seq) (doc : XmlDocument) = else node.InnerText /// Replaces text in a XML file at the location specified by a XPath expression. -let XmlPoke (fileName : string) xpath value = +let XmlPoke (fileName : string) xpath value = let doc = new XmlDocument() doc.Load fileName XPathReplace xpath value doc |> fun x -> x.Save fileName /// Replaces the inner text of an xml node in a XML file at the location specified by a XPath expression. -let XmlPokeInnerText (fileName : string) xpath innerTextValue = +let XmlPokeInnerText (fileName : string) xpath innerTextValue = let doc = new XmlDocument() doc.Load fileName XPathReplaceInnerText xpath innerTextValue doc |> fun x -> x.Save fileName /// Replaces text in a XML document specified by a XPath expression, with support for namespaces. -let XPathReplaceNS xpath value (namespaces : #seq) (doc : XmlDocument) = +let XPathReplaceNS xpath value (namespaces : #seq) (doc : XmlDocument) = let nsmgr = XmlNamespaceManager(doc.NameTable) namespaces |> Seq.iter nsmgr.AddNamespace let node = doc.SelectSingleNode(xpath, nsmgr) if node = null then failwithf "XML node '%s' not found" xpath - else + else node.Value <- value doc /// Replaces inner text in a XML document specified by a XPath expression, with support for namespaces. -let XPathReplaceInnerTextNS xpath innerTextValue (namespaces : #seq) (doc : XmlDocument) = +let XPathReplaceInnerTextNS xpath innerTextValue (namespaces : #seq) (doc : XmlDocument) = let nsmgr = XmlNamespaceManager(doc.NameTable) namespaces |> Seq.iter nsmgr.AddNamespace let node = doc.SelectSingleNode(xpath, nsmgr) if node = null then failwithf "XML node '%s' not found" xpath - else + else node.InnerText <- innerTextValue doc /// Replaces text in a XML file at the location specified by a XPath expression, with support for namespaces. -let XmlPokeNS (fileName : string) namespaces xpath value = +let XmlPokeNS (fileName : string) namespaces xpath value = let doc = new XmlDocument() doc.Load fileName XPathReplaceNS xpath value namespaces doc |> fun x -> x.Save fileName /// Replaces inner text of an xml node in a XML file at the location specified by a XPath expression, with support for namespaces. -let XmlPokeInnerTextNS (fileName : string) namespaces xpath innerTextValue = +let XmlPokeInnerTextNS (fileName : string) namespaces xpath innerTextValue = let doc = new XmlDocument() doc.Load fileName XPathReplaceInnerTextNS xpath innerTextValue namespaces doc |> fun x -> x.Save fileName /// Loads the given text into a XslCompiledTransform. -let XslTransformer text = +let XslTransformer text = if isNullOrEmpty text then null - else + else let xslCompiledTransform = new XslCompiledTransform() XMLDoc(text) |> xslCompiledTransform.Load xslCompiledTransform /// Transforms a XmlDocument using a XslCompiledTransform. /// ## Parameters -/// +/// /// - `xsl` - The XslCompiledTransform which should be applied. /// - `doc` - The XmlDocument to transform. -let XslTransform (xsl : XslCompiledTransform) (doc : XmlDocument) = +let XslTransform (xsl : XslCompiledTransform) (doc : XmlDocument) = use memoryStream = new MemoryStream() use textWriter = new XmlTextWriter(memoryStream, new UTF8Encoding(false)) use writer = System.Xml.XmlWriter.Create(textWriter, xsl.OutputSettings) @@ -206,10 +208,10 @@ let XslTransform (xsl : XslCompiledTransform) (doc : XmlDocument) = /// Transforms a XML file using a XSL stylesheet file. /// ## Parameters -/// +/// /// - `stylesheetUri` - The Uri for the XSL stylesheet file. /// - `fileName` - The XML file to transform. -let XmlTransform (stylesheetUri : string) (fileName : string) = +let XmlTransform (stylesheetUri : string) (fileName : string) = let doc = new XmlDocument() doc.Load fileName let xsl = new XslCompiledTransform()