diff --git a/CLAUDE.md b/CLAUDE.md index 9f34c7e..63ef31b 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -38,7 +38,7 @@ Fast inner loop while working on the library only: `dotnet build src/Partas.Buil ## Current state (verify before assuming) -- Phases 0-7 of `notes/PLAN.md` are done: `dotnet build src/Partas.Build` is clean and `dotnet run --project Build.fsproj -- test` is green (506 Expecto tests across four suites — 365 in `tests/Partas.Build.Tests`, one file per layer, plus 65 in `tests/Partas.Build.ExternalAnnotations.Tests`, 73 in `tests/Partas.ExternalAnnotations.Tests` (2 more ignored) and 3 in `tests/Partas.Build.Cmd.NetStandard.Tests`; the `test` stage also runs `tests/Partas.Build.CompilerProbe` in both Debug and Release, 11 tests each). The `Build/` CLI is written against the library: a breaking change breaks it first. +- Phases 0-7 of `notes/PLAN.md` are done: `dotnet build src/Partas.Build` is clean and `dotnet run --project Build.fsproj -- test` is green (575 Expecto tests across four suites — 431 in `tests/Partas.Build.Tests` (1 more ignored), one file per layer, plus 65 in `tests/Partas.Build.ExternalAnnotations.Tests` (6 more ignored), 73 in `tests/Partas.ExternalAnnotations.Tests` (2 more ignored) and 6 in `tests/Partas.Build.Cmd.NetStandard.Tests`; the `test` stage also runs `tests/Partas.Build.CompilerProbe` in both Debug and Release, 11 tests each). The `Build/` CLI is written against the library: a breaking change breaks it first. - The DSL exists end to end: `inputs` (`Builders/Inputs.fs`), `stage` (`Builders/Stage.fs`), `pipeline` (`Builders/Pipeline.fs`), `command`/`rootCommand` (`Builders/Command.fs`). A stage that declares an input turns its pipeline into an `InputSpec`, and the command registers whatever those specs declare. Conditions are in `Builders/Conditions.fs` — `whenAll`/`whenAny`/`whenNot`/`whenEnv`/`whenStage` plus the `when'`/`whenEnvVar`/`whenBranch`/`when{Windows,Linux,OSX}` operations on `StageBuilder`. - A command carries `PipelineDefaults: BuildPipeline` and takes the pipeline-level operations itself (`workingDir`, `envVars`, the three timeouts, `acceptExitCodes`, the output operations, `noPrefixForStep`/`noStdRedirectForStep`, `runBeforeEachStage`/`runAfterEachStage`, `post`, `verbosity`/`verbose`/`quiet`), each one built through `CommandBuilderBase.MapPipelineDefault`. They are **defaults, not overrides**: `PipelineContext.applyDefaults` copies a setting across only where the pipeline left it at the value `PipelineContext.create` gave it, so a pipeline that sets the same thing wins. See *Command defaults* below. - `run`/`runSensitive` start real processes through `CmdRunner` (`Process.fs`). A `Cmd`, defined in `src/Partas.Build.Cmd/Program.fs`, keeps the executable and its arguments apart all the way to `ProcessStartInfo.ArgumentList`, so the platform does the escaping. Interpolate through the `cmd` helper — `run (cmd $"dotnet build {project}")`. `run $"..."` binds to the `string` overload and flattens the holes; `runSensitive $"..."` takes the `FormattableString` directly and masks every hole as `***`. A function returning a command line is `runLine (fun ctx -> "...")`; the `run` overloads over `StageContext -> string` (and its `Async`/`Task`/`option` forms) are `[]`, since a lambda returning a message would start a process. `runLine` is a separate name, so the `run` overload set — and the `FS0041` balance below — is unchanged. There is no `Fake.Core.Process` dependency; `notes/PLAN.md`'s *The command runner* records why. @@ -94,7 +94,16 @@ writes the result as `Failed` and then propagates to System.CommandLine's handle `Input.sensitive` marks an option or argument as carrying a secret, recorded against the `Symbol` in a `ConditionalWeakTable` in `Inputs.fs` (System.CommandLine has no property bag); `--schema` writes a marked symbol's present default as `"***"` alongside `"sensitive": true`. `Baked.NuGet.apiKey` is marked, since its -default is read from `NUGET_API_KEY`. Text `--help` still prints the default. +default is read from `NUGET_API_KEY`. Text `--help` still prints the default. `ActionInput.GetValue` registers +every value it reads from a marked symbol with `Cmd.Redaction` (process-wide, in `Partas.Build.Cmd`), and +`Cmd.toLogString` and `--explain`'s labels mask each registered value, as a whole argument or inside one, so a +secret interpolated through `cmd`, the string `run` or `Cmd.ofList` prints as `***` and still reaches the process. + +A stage body is built eagerly (`Delay` runs it at once), conditions included or not. Each `StageBuilder.Delay` +runs under `Construction.inStage`, which records the stage's name on the `Data` of any exception the body +raises and rethrows it unchanged; `Builders/Command.fs`'s `reportBuildFailure` turns an exception out of +reading the pipelines into a failed invocation naming the command and those stages, through the annotation +and `--json`/`--report` result paths, instead of System.CommandLine's unhandled-exception handler. `Failures.fs` holds what a scope reports about itself, apart from what it prints. A `ScopeReport` carries three fields: `Outcome` (the scope's own `StageOutcome`), `Propagates` (whether that failure fails the scope diff --git a/docs/content/Build/CAPABILITIES.md b/docs/content/Build/CAPABILITIES.md index fc4308b..2ca3a86 100644 --- a/docs/content/Build/CAPABILITIES.md +++ b/docs/content/Build/CAPABILITIES.md @@ -402,6 +402,12 @@ accepts is accepted, and the stage runs for real, side effects included. `StageContext list`: the stage built from the bound value, or `[]`. The absent case is an empty list, not an inactive stage requiring a name. `build` receives the value already unwrapped, inside the condition that guards it. +A condition decides whether a stage runs, not whether it is built: a stage body, both branches of an `if` +included, is built before any condition is evaluated. `key.Value` under `when' key.IsSome` throws while the +stage is built when `key` is `None`; `whenSome key (fun key -> ...)` builds the stage only for `Some`. An +exception raised while a command builds its stages fails the invocation (exit `1`) with a message naming the +command and the stages being built. + ## `Input` combinators Declaring functions: @@ -429,7 +435,7 @@ Shaping combinators, all `ActionInput<'T> -> ActionInput<'T>` and all pipeable: | `Input.required` | Marks an option required | | `Input.recursive` | Applies the option to the command and, recursively, its subcommands | | `Input.hidden` | Keeps it out of help output | -| `Input.sensitive` | Marks the symbol secret: `--schema` reports it `"sensitive": true` and writes a present default as `"***"` | +| `Input.sensitive` | Marks the symbol secret: each value read from it prints as `***` in every logged or explained command line, and `--schema` reports it `"sensitive": true` with a present default written as `"***"` | | `Input.allowMultipleArgumentsPerToken` | Lets one identifier token carry several values | | `Input.acceptOnlyFromAmong` | Restricts to a set of legal strings, ordinally | | `Input.addCompletion` / `Input.addCompletions` | Adds tab-completion suggestions without restricting what is accepted | diff --git a/docs/content/Build/execution.md b/docs/content/Build/execution.md index 3ff772f..38c7aa7 100644 --- a/docs/content/Build/execution.md +++ b/docs/content/Build/execution.md @@ -66,6 +66,7 @@ Post stages run after the main stages, including after failure. - `continueStageOnFailure`: let the pipeline continue. - `continueOnStepFailure`: apply both. - `acceptExitCodes`: accept additional process exit codes. -- `failIfIgnored`: treat a skipped stage as failure. +- `failIfIgnored`: treat a skipped stage as failure. The stage body is still built when the stage is skipped; + bind a value that exists only when the stage runs with `whenSome`. For typed outputs and prerequisite ordering, use [producers and dependencies](CAPABILITIES.md#producers-and-dependencies). For recovery policies, see [failure handlers](CAPABILITIES.md#failure-handlers). diff --git a/docs/content/Build/inputs.md b/docs/content/Build/inputs.md index cc375ba..85c6158 100644 --- a/docs/content/Build/inputs.md +++ b/docs/content/Build/inputs.md @@ -52,6 +52,7 @@ If one value depends on another, derive it after binding. Keep runtime work insi - `Input.def value`: a default. - `Input.acceptOnlyFromAmong values`: validation against a fixed set. - `Input.map f`: transform a parsed value. -- `Input.sensitive`: hide the value in structured inspection. +- `Input.sensitive`: mask the value as `***` in every printed command line (the run log, `--explain` and its + JSON) and in `--schema`. The process still receives it unmasked. See [Capabilities](CAPABILITIES.md#input-combinators) for the complete list and [Baked](baked.md) for ready-made inputs. diff --git a/src/Partas.Build.Cmd/Program.fs b/src/Partas.Build.Cmd/Program.fs index 3bbd2a3..99a65cf 100644 --- a/src/Partas.Build.Cmd/Program.fs +++ b/src/Partas.Build.Cmd/Program.fs @@ -44,6 +44,35 @@ module Cmd = [] let private mask = "***" + /// Values masked wherever a is printed, in any argument. + /// + /// The set is process-wide, and a registered value stays masked for the lifetime of the process. + /// Input.sensitive registers every value read from a marked input. A registered value prints as + /// *** as a whole argument and inside a longer one (--api-key=***). + /// + module Redaction = + let private values = Collections.Generic.HashSet(StringComparer.Ordinal) + // Longest first, so a value containing another registered value is masked whole. + let mutable private ordered: string array = [||] + + /// Adds a value to the masked set. A null, empty or whitespace value is ignored. + let register (value: string) = + if not (String.IsNullOrWhiteSpace value) then + lock values (fun () -> + if values.Add value then + ordered <- values |> Seq.sortByDescending (fun value -> value.Length) |> Array.ofSeq) + + /// Replaces every occurrence of a registered value in the text with ***. + let redact (text: string) = + let ordered = ordered + + if String.IsNullOrEmpty text || ordered.Length = 0 then text + else + let mutable redacted = text + for value in ordered do + if redacted.Contains value then redacted <- redacted.Replace(value, mask) + redacted + /// Accumulates tokens across literal fragments and interpolated values. /// /// A token ends at unquoted whitespace and nowhere else, so a value glued to literal text @@ -220,8 +249,8 @@ module Cmd = acc.ToCmd() - /// How the command is printed: secrets masked, and anything containing whitespace quoted so the - /// printed form can be pasted into a shell. + /// How the command is printed: secrets and every value registered with Redaction masked, and anything + /// containing whitespace quoted so the printed form can be pasted into a shell. let toLogString (cmd: Cmd) = let quoteIfNeeded (value: string) = if String.IsNullOrEmpty value then "\"\"" @@ -229,8 +258,8 @@ module Cmd = else value cmd.Arguments - |> List.mapi (fun i arg -> if cmd.Secrets.Contains i then mask else quoteIfNeeded arg) - |> List.append [ quoteIfNeeded cmd.Executable ] + |> List.mapi (fun i arg -> if cmd.Secrets.Contains i then mask else quoteIfNeeded (Redaction.redact arg)) + |> List.append [ quoteIfNeeded (Redaction.redact cmd.Executable) ] |> String.concat " " diff --git a/src/Partas.Build/Builders/Command.fs b/src/Partas.Build/Builders/Command.fs index 2cf9293..660120f 100644 --- a/src/Partas.Build/Builders/Command.fs +++ b/src/Partas.Build/Builders/Command.fs @@ -129,6 +129,44 @@ let private reportResult (output: TextWriter) (parseResult: ParseResult) (exitCo exitCode +/// Reports an exception raised while the command built its pipelines as a failed invocation. +/// +/// The message names the command, the stages being built and the input being read where they are known, and +/// carries the original exception's type and message. It is printed as an error annotation, the way a failed +/// stage's is. The run result holds one pipeline named after the command, with no timings and one report +/// addressed by the stages being built, an empty Path, and the exception as its Raised cause. +/// Under --explain no run result is written. +/// +let private reportBuildFailure (output: TextWriter) (parseResult: ParseResult) (state: InvocationState) (explaining: bool) (commandName: string) (error: exn) = + let stages = Construction.stagePath error + let address = ScopeAddress.text { Path = []; Names = stages } + let site = [ + if not stages.IsEmpty then $"stage (%s{address})" + match Construction.inputName error with + | ValueSome input -> $"input (%s{input})" + | ValueNone -> () + ] + let location = if site.IsEmpty then "" else " in " + String.concat ", " site + let cause = FailureCause.Raised error + let message = $"Command (%s{commandName}) failed while building its pipelines%s{location}. %s{FailureCause.describe cause}" + + { Annotation.error message with Title = ValueSome ("[COMMAND] " + commandName) } + |> WorkflowCommands.writeAnnotation (PipelineContext.ambientEnvironment ()) + + if explaining then ExitCode.Failure + else + let report = { + Name = List.tryLast stages |> Option.defaultValue commandName + Address = { Path = []; Names = stages } + Outcome = StageOutcome.Failed error.Message + Propagates = true + Failures = [ { Index = StepFailure.NoStep; Label = ValueNone; Cause = cause } ] + Exceptions = [ error ] + Nested = [] + } + state.Record { Name = commandName; Reports = [ report ]; Timings = [] } + reportResult output parseResult ExitCode.Failure state.Pipelines + /// /// Reads each pipeline out of the parse result and runs it, in declaration order. Producer work is placed into /// the pipelines that run, after the whole invocation validates and never on the way to --explain. @@ -137,7 +175,8 @@ let private reportResult (output: TextWriter) (parseResult: ParseResult) (exitCo /// A pipeline failure or cancellation maps to its exit code; the runner has already printed it. Any other /// exception writes the run result as a failure, then propagates to System.CommandLine's exception handler. /// Under --explain, a failed dependency validation prints its message to the error writer and exits -/// UsageError without a run result. +/// UsageError without a run result. An exception raised while reading the pipelines (building their +/// stages) fails the invocation through reportBuildFailure, under --explain too. /// let private invoke (command: Command) (spec: CommandSpec) (parseResult: ParseResult) = // Parse results invoked straight through System.CommandLine get a state of their own, so that `--json` and @@ -150,7 +189,16 @@ let private invoke (command: Command) (spec: CommandSpec) (parseResult: ParseRes let configuration = parseResult.InvocationConfiguration let asJson = MachineOutput.isSet MachineOutput.json parseResult let explaining = MachineOutput.isSet Explain.option parseResult - let pipelines = spec.Pipelines |> List.map (fun pipeline -> pipeline.Read parseResult) + match + try Ok(spec.Pipelines |> List.map (fun pipeline -> pipeline.Read parseResult)) + with error -> Error error + with + | Error error -> + let name = + if not (String.IsNullOrEmpty spec.Name) then spec.Name + else spec.DisplayName |> ValueOption.defaultValue command.Name + reportBuildFailure configuration.Output parseResult state explaining name error + | Ok pipelines -> match DependencyPlan.validate pipelines with | Error message -> configuration.Error.WriteLine message diff --git a/src/Partas.Build/Builders/Conditions.fs b/src/Partas.Build/Builders/Conditions.fs index 6d9e31d..2004284 100644 --- a/src/Partas.Build/Builders/Conditions.fs +++ b/src/Partas.Build/Builders/Conditions.fs @@ -308,6 +308,7 @@ type StageBuilder with /// /// /// The value is typically a boolean bound by an enclosing input CE. + /// /// /// [] @@ -318,6 +319,7 @@ type StageBuilder with /// /// /// when' (not quick) "--quick is set" renders a skipped stage as (skipped: --quick is set). + /// /// /// /// @@ -546,9 +548,9 @@ let inline whenStage name = WhenStageBuilder name module ValueConditions = /// Yields the stage makes of the value, and nothing when there is none. /// - /// The alternative is when' value.IsSome above a run that reaches for value.Value, - /// which is correct only because of evaluation order — nothing the compiler checks, and a refactor that - /// moves the condition below the step compiles cleanly and throws at run time. + /// The stage is built only for Some, and closes over the value itself. A when' value.IsSome + /// guards running, not building: a stage body that reads value.Value under it throws a + /// NullReferenceException while the stage is built, whatever the condition says. /// /// The absent case is an empty list, not an inactive stage requiring a name. /// diff --git a/src/Partas.Build/Builders/Stage.fs b/src/Partas.Build/Builders/Stage.fs index f4c3f3a..7accda0 100644 --- a/src/Partas.Build/Builders/Stage.fs +++ b/src/Partas.Build/Builders/Stage.fs @@ -30,6 +30,9 @@ let private advanced = EditorBrowsableState.Advanced [] type StageBuilder(name: string) = inherit StageSettingsBuilder() + /// The name of the stage the builder builds. + [] + member _.Name = name [] // `Run` is deliberately not `inline`: `BuildStage` is a plain function type rather than a delegate, // and inlining an application of one defeats the optimiser (`FS1118`) in Release builds only. // It applies a closure once at construction time, so there is nothing to gain by inlining it. @@ -70,18 +73,20 @@ type StageBuilder(name: string) = // ================================================================= // Delay // ================================================================= + // Each `Delay` runs the body at once under `Construction.inStage`, which records the stage's name on any + // exception the body raises. [] - member inline _.Delay ([] fn): BuildStage = fn() + member inline this.Delay ([] fn): BuildStage = Construction.inStage this.Name (fun () -> fn()) [] - member inline _.Delay ([] fn) = StageContext.addSubStage (fn()) + member inline this.Delay ([] fn) = Construction.inStage this.Name (fun () -> StageContext.addSubStage (fn())) [] - member inline _.Delay ([] fn) = StageContext.addStepFn (fn()) + member inline this.Delay ([] fn) = Construction.inStage this.Name (fun () -> StageContext.addStepFn (fn())) [] - member inline _.Delay ([] fn) = StageContext.addPredicate (fn()) + member inline this.Delay ([] fn) = Construction.inStage this.Name (fun () -> StageContext.addPredicate (fn())) [] - member inline _.Delay ([] fn): InputSpec = fn () + member inline this.Delay ([] fn): InputSpec = Construction.inStage this.Name (fun () -> fn ()) [] - member inline _.Delay ([] fn) = InputSpec.map StageContext.addSubStage (fn()) + member inline this.Delay ([] fn) = Construction.inStage this.Name (fun () -> InputSpec.map StageContext.addSubStage (fn())) // ================================================================= // Combine // ================================================================= diff --git a/src/Partas.Build/Builders/StageSettings.fs b/src/Partas.Build/Builders/StageSettings.fs index a5aa3bc..a121bc9 100644 --- a/src/Partas.Build/Builders/StageSettings.fs +++ b/src/Partas.Build/Builders/StageSettings.fs @@ -124,7 +124,10 @@ type StageSettingsBuilder() = member inline _.acceptExitCodes (state: ^State, codes: int seq): ^State = StageMap.mapStage (fun ctx -> { ctx with AcceptableExitCodes = set codes }) state /// Fails the pipeline if this stage is inactive. - /// By default, inactive stages are skipped without failure. Enable this to treat an inactive stage as a pipeline error. + /// + /// By default, inactive stages are skipped without failure. Enable this to treat an inactive stage as a pipeline error. + /// + /// [] member inline _. failIfIgnored (state: ^State, ?flag: bool): ^State = StageMap.mapStage (fun ctx -> { ctx with FailIfIgnored = defaultArg flag true }) state diff --git a/src/Partas.Build/Construction.fs b/src/Partas.Build/Construction.fs new file mode 100644 index 0000000..6bb6904 --- /dev/null +++ b/src/Partas.Build/Construction.fs @@ -0,0 +1,53 @@ +namespace Partas.Build + +open System.ComponentModel + +/// Where an exception raised while a command builds its pipelines came from. +/// +/// The stage builder and the input readers record their names on the exception's Data and rethrow it +/// unchanged: its type, message and stack trace remain those of the original exception. +/// +[] +module Construction = + [] + let private StagesKey = "Partas.Build.Construction.Stages" + + [] + let private InputKey = "Partas.Build.Construction.Input" + + let private tryRead (key: string) (error: exn) = + try error.Data[key] with _ -> null + + let private tryWrite (key: string) (value: obj) (error: exn) = + try error.Data[key] <- value with _ -> () + + /// The names of the stages being built when the exception was raised, outermost first. + /// Empty for an exception raised outside every stage body. + let stagePath (error: exn) : string list = + match tryRead StagesKey error with + | :? (string array) as names -> List.ofArray names + | _ -> [] + + /// The name of the input being read when the exception was raised. + let inputName (error: exn) : string voption = + match tryRead InputKey error with + | :? string as name -> ValueSome name + | _ -> ValueNone + + /// Runs a stage body, recording the stage's name on any exception the body raises. + [] + let inStage (name: string) (build: unit -> 'T) : 'T = + try + build () + with error -> + tryWrite StagesKey (Array.ofList (name :: stagePath error)) error + reraise () + + /// Reads an input's value, recording the input's name on any exception the read raises. + [] + let readingInput (name: string) (read: unit -> 'T) : 'T = + try + read () + with error -> + if (inputName error).IsNone then tryWrite InputKey name error + reraise () diff --git a/src/Partas.Build/Explain.fs b/src/Partas.Build/Explain.fs index b2673d5..fcbfbbc 100644 --- a/src/Partas.Build/Explain.fs +++ b/src/Partas.Build/Explain.fs @@ -61,7 +61,7 @@ type ExplainedStage = { /// A step as --explain describes it; index counts from zero, as a run result's step and /// path do. -/// A label is the step's log form, with every secret masked. +/// A label is the step's log form, with every secret and every sensitive input's value masked. and [] ExplainedStep = | Step of index: int * label: string voption | Operation of index: int * label: string voption @@ -167,8 +167,8 @@ module Explain = match step with | Step.StepOfStage subStage -> ExplainedStep.Stage(index, explainStage mode { subStage with ParentContext = ValueSome(StageParent.Stage stage) }) - | Step.StepFn(label, _) -> ExplainedStep.Step(index, label) - | Step.Operation(label, _) -> ExplainedStep.Operation(index, label)) + | Step.StepFn(label, _) -> ExplainedStep.Step(index, ValueOption.map Cmd.Redaction.redact label) + | Step.Operation(label, _) -> ExplainedStep.Operation(index, ValueOption.map Cmd.Redaction.redact label)) } /// The tree of , with each stage's conditions answered under diff --git a/src/Partas.Build/Partas.Build.fsproj b/src/Partas.Build/Partas.Build.fsproj index de8de0c..9efa0b9 100644 --- a/src/Partas.Build/Partas.Build.fsproj +++ b/src/Partas.Build/Partas.Build.fsproj @@ -14,6 +14,7 @@ + diff --git a/src/Partas.Build/System.CommandLine/Inputs.fs b/src/Partas.Build/System.CommandLine/Inputs.fs index ab2ae5e..2ca2cae 100644 --- a/src/Partas.Build/System.CommandLine/Inputs.fs +++ b/src/Partas.Build/System.CommandLine/Inputs.fs @@ -88,16 +88,62 @@ type ActionInputSource = | Context | Injection of obj +/// The symbols marked by Input.sensitive, and the registration of the values read from them. +module internal SensitiveSymbols = + let private marked = System.Runtime.CompilerServices.ConditionalWeakTable() + + let mark (symbol: Symbol) = + lock marked (fun () -> + match marked.TryGetValue symbol with + | true, _ -> () + | false, _ -> marked.Add(symbol, obj ())) + + let isMarked (symbol: Symbol) = + match marked.TryGetValue symbol with + | true, _ -> true + | false, _ -> false + + /// Registers every string a value carries for masking: a string itself, the contents of an option or a + /// collection, and the invariant text of any other value apart from a bool. + let rec private register (value: obj) = + match value with + | null + | :? bool -> () + | :? string as text -> Cmd.Redaction.register text + | :? Collections.IEnumerable as values -> + for value in values do + register value + | _ -> + let valueType = value.GetType() + + if valueType.IsGenericType && valueType.GetGenericTypeDefinition() = typedefof> then + register (valueType.GetProperty("Value").GetValue value) + elif valueType.IsGenericType && valueType.GetGenericTypeDefinition() = typedefof> then + match valueType.GetProperty("IsSome").GetValue value with + | :? bool as isSome when isSome -> register (valueType.GetProperty("Value").GetValue value) + | _ -> () + else + Cmd.Redaction.register (Convert.ToString(value, Globalization.CultureInfo.InvariantCulture)) + + /// Reads a symbol's value, registering it for masking when the symbol is marked. + let read (symbol: Symbol) (read: unit -> 'T) : 'T = + let value = Construction.readingInput symbol.Name read + if isMarked symbol then register (box value) + value + type ActionInput(source: ActionInputSource) = member this.Source = source type ActionInput<'T>(inputType: ActionInputSource) = inherit ActionInput(inputType) static member OfOption<'T>(o: Option<'T>) = ParsedOption o |> ActionInput<'T> static member OfArgument<'T>(a: Argument<'T>) = ParsedArgument a |> ActionInput<'T> + /// The value parsed for the option or argument, or the context or injected value. + /// A value read from an input marked by Input.sensitive is masked in every printed command + /// from then on. member this.GetValue<'T>(parseResult: ParseResult) = match this.Source with - | ParsedOption o -> o :?> Option<'T> |> parseResult.GetValue - | ParsedArgument a -> a :?> Argument<'T> |> parseResult.GetValue + | ParsedOption o -> SensitiveSymbols.read o (fun () -> o :?> Option<'T> |> parseResult.GetValue) + | ParsedArgument a -> SensitiveSymbols.read a (fun () -> a :?> Argument<'T> |> parseResult.GetValue) | Context -> parseResult |> unbox<'T> | Injection i -> i |> unbox<'T> @@ -436,29 +482,22 @@ module Input = ) let mapFromMany<'T> choices action: ActionInput<'T list> = mapFromManyWith StringComparer.Ordinal choices action - let private sensitiveSymbols = System.Runtime.CompilerServices.ConditionalWeakTable() - - let private markSensitive (symbol: Symbol) = - lock sensitiveSymbols (fun () -> - match sensitiveSymbols.TryGetValue symbol with - | true, _ -> () - | false, _ -> sensitiveSymbols.Add(symbol, obj ())) - /// Marks an option or argument as carrying a secret. /// - /// --schema writes the default of a marked symbol as "***" and reports it "sensitive": true. - /// Text --help still prints the default. + /// Every value read from a marked input is masked as *** wherever a command is printed (the run log, + /// --explain and its JSON, a failed command's message), however the command line was built, and still + /// reaches the process unmasked. An option or a collection masks each value it carries; any other non-string + /// value masks its invariant text, and a bool masks nothing. A null, empty or whitespace value is never masked. + /// --schema writes the default of a marked symbol as "***" and reports it + /// "sensitive": true. Text --help still prints the default. /// let sensitive (input: ActionInput<'T>) = input - |> editOption (fun o -> markSensitive o) - |> editArgument (fun a -> markSensitive a) + |> editOption (fun o -> SensitiveSymbols.mark o) + |> editArgument (fun a -> SensitiveSymbols.mark a) /// Whether is marked by sensitive. - let isSensitive (symbol: Symbol) = - match sensitiveSymbols.TryGetValue symbol with - | true, _ -> true - | false, _ -> false + let isSensitive (symbol: Symbol) = SensitiveSymbols.isMarked symbol /// Hides an option or argument from the help output. let hidden (input: ActionInput<'T>) = diff --git a/src/Partas.Build/xmldoc/conditions.xml b/src/Partas.Build/xmldoc/conditions.xml index 00da7e1..1f5958c 100644 --- a/src/Partas.Build/xmldoc/conditions.xml +++ b/src/Partas.Build/xmldoc/conditions.xml @@ -8,6 +8,12 @@ remarks-level content (, , text) and never a of its own. Conditions conjoin rather than replace: a second condition narrows the stage to the logical AND of both, it does not overwrite the first. To widen instead of narrow, pass a single whenAny { } block. + + A condition decides whether the stage runs, not whether it is built. The whole body (both branches of + an if, and every nested stage) is built with the stage, before any condition is evaluated. A value + that exists only when the condition holds, such as key.Value under when' key.IsSome, belongs in + whenSome, whose stage is built only for Some. + A custom operation cannot sit under an if or a match inside a computation expression. A stage that needs to branch must build the value first and apply the operation unconditionally. diff --git a/tests/Partas.Build.Cmd.NetStandard.Tests/NetStandardCmdTests.fs b/tests/Partas.Build.Cmd.NetStandard.Tests/NetStandardCmdTests.fs index 41dcb55..ba77fe7 100644 --- a/tests/Partas.Build.Cmd.NetStandard.Tests/NetStandardCmdTests.fs +++ b/tests/Partas.Build.Cmd.NetStandard.Tests/NetStandardCmdTests.fs @@ -59,4 +59,28 @@ let tests = Expect.equal result.exitCode 0 "the child should accept its arguments" Expect.equal delivered awkward "the Arguments string should deliver the boundaries ArgumentList does" } + + test "a registered value is masked in the log form as a whole argument and inside one" { + let key = "fake-ns-key-7f3a" + Cmd.Redaction.register key + let pushed = Cmd.ofList "tool" [ "push"; "-k"; key; $"--api-key={key}" ] + + Expect.equal (Cmd.toLogString pushed) "tool push -k *** --api-key=***" "the value is masked wherever it appears" + Expect.equal pushed.Arguments [ "push"; "-k"; key; $"--api-key={key}" ] "the process still receives the value" + } + + test "a value containing a shorter registered value is masked whole" { + Cmd.Redaction.register "fake-ns-short" + Cmd.Redaction.register "fake-ns-short-and-long" + + Expect.equal (Cmd.Redaction.redact "x=fake-ns-short-and-long") "x=***" "the longer value is masked as one" + } + + test "an empty or whitespace value is never registered" { + Cmd.Redaction.register "" + Cmd.Redaction.register " " + Cmd.Redaction.register null + + Expect.equal (Cmd.toLogString (Cmd.ofList "tool" [ "a b"; "plain" ])) "tool \"a b\" plain" "whitespace stays printable" + } ] diff --git a/tests/Partas.Build.Tests/CmdTests.fs b/tests/Partas.Build.Tests/CmdTests.fs index 0059737..b4704e6 100644 --- a/tests/Partas.Build.Tests/CmdTests.fs +++ b/tests/Partas.Build.Tests/CmdTests.fs @@ -239,6 +239,32 @@ let tests = Expect.isFalse ((Cmd.toLogString pushed).Contains "super-secret-key") "the key never reaches log" } + test "a step's printed command line masks a sensitive input's value and the process receives it" { + let value = "fake-run-key-c4a9" + let key = Input.option "--key" |> Input.sensitive + let child = ResizeArray() + let root = Command.root { + pipeline "publish" { + verbose + input { + let! key = key + return stage "push" { + redirectOutput (fun _ line -> lock child (fun () -> child.Add line)) + run (Cmd.ofList "dotnet" [ Helpers.ProcessFixture.assemblyPath; "args"; key ]) + } + } + } + } + use output = new System.IO.StringWriter() + + let result = root.Invoke([ "--key"; value ], output = output) + + Expect.equal result.ExitCode ExitCode.Success "the step runs" + Expect.sequenceEqual child [ $"{value.Length}:{value}" ] "the process receives the value unmasked" + Expect.isFalse (output.ToString().Contains value) "the run log carries no part of the key" + Expect.stringContains (output.ToString()) "args ***" "the logged command line masks it" + } + test "secretOptionWhenSome omits flag entirely when there is no value" { let baseline = Cmd.ofList "dotnet" [ "nuget"; "push"; "pkg.nupkg" ] let applied = baseline |> Cmd.secretOptionWhenSome "-k" (Some "key") diff --git a/tests/Partas.Build.Tests/CommandTests.fs b/tests/Partas.Build.Tests/CommandTests.fs index 3ee3f32..6805783 100644 --- a/tests/Partas.Build.Tests/CommandTests.fs +++ b/tests/Partas.Build.Tests/CommandTests.fs @@ -426,6 +426,28 @@ let defaultsTests = } ] +/// A root shaped like a publish command whose `push` stage reads `apiKey.Value` while it is built, so building it +/// without `--api-key` or `--dry-publish` raises a NullReferenceException. +let private keylessPublishRoot () = + let apiKey = Input.optionMaybe "--api-key" |> Input.sensitive + let dryPublish = Input.option "--dry-publish" + + Command.root { + input { + let! apiKey = apiKey + and! dryPublish = dryPublish + return + stage "publish" { + failIfIgnored + when' (dryPublish || apiKey.IsSome) + if dryPublish then + stage "dry publish" { run noop } + else + stage "push" { run (cmd $"dotnet nuget push pkg -k {apiKey.Value}") } + } + } + } + /// A root whose one pipeline records the configuration it ran with, and fails under --fail. let private recordingRoot (seen: ResizeArray) = let config = Input.option "--configuration" |> Input.def "Debug" @@ -492,6 +514,54 @@ let invocation = Expect.isEmpty first.Failures "a later failing run leaves an earlier result untouched" } + test "an exception raised while building a command's stages fails the invocation naming the stage" { + use output = new StringWriter() + use error = new StringWriter() + let result = Helpers.quietly (fun () -> (keylessPublishRoot ()).Invoke([], output = output, error = error)) + let printed = output.ToString() + error.ToString() + + Expect.equal result.ExitCode ExitCode.Failure "a build failure exits one" + Expect.equal result.Outcome RunOutcome.Failed "the outcome names the category" + Expect.isFalse (printed.Contains "Unhandled exception") "the failure is reported, not left unhandled" + Expect.stringContains printed "publish/push" "the message names the stage being built" + Expect.stringContains printed "NullReferenceException" "the message keeps the original exception" + match result.Failures with + | [ { Cause = FailureCause.Raised raised } ] -> Expect.isTrue (raised :? NullReferenceException) "the cause is the original exception" + | failures -> failtestf "expected one raised failure, got %A" failures + } + + test "an exception raised while building a command's stages reaches --json as a failed result" { + use output = new StringWriter() + let result = Helpers.quietly (fun () -> (keylessPublishRoot ()).Invoke([ "--json" ], output = output)) + let json = output.ToString().Split([| '\n' |], StringSplitOptions.RemoveEmptyEntries) |> Array.last + let document = JsonDocument.Parse(json).RootElement + + Expect.equal result.ExitCode ExitCode.Failure "a build failure exits one" + Expect.equal (document.GetProperty("outcome").GetString()) "failed" "the result is failed" + let report = document.GetProperty("pipelines").EnumerateArray() |> Seq.exactlyOne |> _.GetProperty("reports").EnumerateArray() |> Seq.exactlyOne + Expect.equal (report.GetProperty("address").GetString()) "publish/push" "the report addresses the stage being built" + let cause = report.GetProperty("failures").EnumerateArray() |> Seq.exactlyOne |> _.GetProperty("cause") + Expect.equal (cause.GetProperty("kind").GetString()) "raised" "the cause is a raised exception" + Expect.equal (cause.GetProperty("exceptionType").GetString()) typeof.FullName "of the original type" + } + + test "an exception raised while building a command's stages fails --explain naming the stage" { + use output = new StringWriter() + use error = new StringWriter() + let result = (keylessPublishRoot ()).Invoke([ "--explain" ], output = output, error = error) + let printed = output.ToString() + error.ToString() + + Expect.equal result.ExitCode ExitCode.Failure "a build failure exits one under --explain too" + Expect.isFalse (printed.Contains "Unhandled exception") "the failure is reported, not left unhandled" + Expect.stringContains printed "publish/push" "the message names the stage being built" + } + + test "the publish command builds and runs its dry branch" { + let result = Helpers.quietly (fun () -> (keylessPublishRoot ()) |> Command.invoke [ "--dry-publish"; "true" ]) + + Expect.equal result.ExitCode ExitCode.Success "the dry branch builds without reading the key" + } + test "a parse error exits two and runs nothing" { let seen = ResizeArray() use output = new StringWriter() diff --git a/tests/Partas.Build.Tests/ExplainTests.fs b/tests/Partas.Build.Tests/ExplainTests.fs index e6a8cf9..bde7a09 100644 --- a/tests/Partas.Build.Tests/ExplainTests.fs +++ b/tests/Partas.Build.Tests/ExplainTests.fs @@ -350,3 +350,46 @@ let tests = Expect.equal (subcommand |> property "description" |> text) "does the thing" "with its description" } ] + +[] +let sensitiveInputs = + /// A command whose stage builds the same command line three ways from one sensitive option. + let publishing (key: ActionInput) = + command "publish" { + pipeline "p" { + input { + let! key = key + return stage "push" { + run (cmd $"dotnet nuget push pkg -k {key}") + run $"dotnet nuget push pkg --api-key={key}" + run (Cmd.ofList "dotnet" [ "nuget"; "push"; "pkg"; "-k"; key ]) + } + } + } + } + + testList "explain sensitive inputs" [ + test "explain masks a sensitive input's value however the command line was built" { + let value = "fake-explain-key-0b7d" + let built = publishing (Input.option "--key" |> Input.sensitive) + + let _, printed = capturingOut (fun () -> built.Parse($"--key {value} --explain --json false").Invoke()) + + Expect.isFalse (printed.Contains value) "the text tree carries no part of the key" + Expect.stringContains printed "-k ***" "a separate argument is masked" + Expect.stringContains printed "--api-key=***" "a glued argument is masked" + } + + test "explain --json masks a sensitive input's value in every step label" { + let value = "fake-explain-json-key-4e21" + let built = publishing (Input.option "--key" |> Input.sensitive) + + use output = new StringWriter() + built.Parse($"--key {value} --explain --json").Invoke(System.CommandLine.InvocationConfiguration(Output = output)) |> ignore + let json = output.ToString() + + Expect.isFalse (json.Contains value) "the JSON form carries no part of the key" + let labels = [ for step in JsonDocument.Parse(json).RootElement |> property "pipelines" |> items |> List.exactlyOne |> stageNamed "push" |> property "steps" |> items -> step |> property "label" |> text ] + Expect.equal labels [ "dotnet nuget push pkg -k ***"; "dotnet nuget push pkg --api-key=***"; "dotnet nuget push pkg -k ***" ] "each label is masked" + } + ] diff --git a/tests/Partas.Build.Tests/InputsTests.fs b/tests/Partas.Build.Tests/InputsTests.fs index e053966..d8cbeb7 100644 --- a/tests/Partas.Build.Tests/InputsTests.fs +++ b/tests/Partas.Build.Tests/InputsTests.fs @@ -310,3 +310,44 @@ let tests = Expect.equal (input.GetValue parsed |> List.map (fun l -> l.Name)) [ "ast"; "proto" ] "in the order given" } ] + +[] +let sensitiveValues = + testList "sensitive input values" [ + test "reading a sensitive option masks its value in every printed command" { + let key = Input.option "--key" |> Input.sensitive + let value = "fake-inputs-key-91c2" + let read = (InputSpec.ofInput key).Read (parse [ key ] $"--key {value}") + + Expect.equal read value "the read value is the value itself" + Expect.equal (Cmd.toLogString (Cmd.ofString $"tool push -k {read}")) "tool push -k ***" "a string command masks it" + Expect.equal (Cmd.toLogString (cmd $"tool push --key={read}")) "tool push --key=***" "an interpolated command masks it" + Expect.equal (Cmd.toLogString (Cmd.ofList "tool" [ "-k"; read ])) "tool -k ***" "a list command masks it" + } + + test "reading a sensitive option, list or non-string input masks each value it carries" { + let maybe = Input.optionMaybe "--maybe-key" |> Input.sensitive + let many = Input.option "--many-key" |> Input.sensitive + let pin = Input.option "--pin" |> Input.sensitive + let parsed = parse [ maybe; many; pin ] "--maybe-key fake-maybe-3d1e --many-key fake-many-a1 --many-key fake-many-b2 --pin 482913" + + Expect.equal ((InputSpec.ofInput maybe).Read parsed) (Some "fake-maybe-3d1e") "the option reads Some" + Expect.equal ((InputSpec.ofInput many).Read parsed) [ "fake-many-a1"; "fake-many-b2" ] "the list reads both" + Expect.equal ((InputSpec.ofInput pin).Read parsed) 482913 "the int reads as given" + + Expect.equal + (Cmd.toLogString (Cmd.ofList "tool" [ "fake-maybe-3d1e"; "fake-many-a1"; "fake-many-b2"; "--pin=482913" ])) + "tool *** *** *** --pin=***" + "every carried value is masked" + } + + test "an unmarked input, and a blank sensitive value, mask nothing" { + let plain = Input.option "--plain" + let blank = Input.option "--blank" |> Input.sensitive |> Input.def " " + let parsed = parse [ plain; blank ] "--plain fake-plain-value-55" + + Expect.equal ((InputSpec.ofInput plain).Read parsed) "fake-plain-value-55" "the plain value reads" + Expect.equal ((InputSpec.ofInput blank).Read parsed) " " "the blank default reads" + Expect.equal (Cmd.toLogString (Cmd.ofList "tool" [ "fake-plain-value-55"; "a b" ])) "tool fake-plain-value-55 \"a b\"" "both stay printable" + } + ] diff --git a/tests/Partas.Build.Tests/StageTests.fs b/tests/Partas.Build.Tests/StageTests.fs index 78b10ae..00b970e 100644 --- a/tests/Partas.Build.Tests/StageTests.fs +++ b/tests/Partas.Build.Tests/StageTests.fs @@ -56,6 +56,22 @@ let tests = Expect.equal (stageNames ctx) [ "stage:inner"; "fn" ] "the nested stage must not be discarded" } + test "an exception raised while a stage is built carries the path of the stages being built" { + let missing: string option = None + + let raised = + try + stage "publish" { stage "push" { run (cmd $"dotnet nuget push pkg -k {missing.Value}") } } |> ignore + None + with error -> Some error + + match raised with + | Some error -> + Expect.isTrue (error :? NullReferenceException) "the original exception propagates unchanged" + Expect.equal (Construction.stagePath error) [ "publish"; "push" ] "the path names each stage, outermost first" + | None -> failtest "the stage body should raise while it is built" + } + test "is active by default" { let ctx = stage "plain" { run noop } Expect.isTrue (ctx.IsActive ctx) "a stage declaring no condition is active"