@clear-capabilities/agentic-security-scanner 0.195.11 → 0.195.12
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- package/CHANGELOG.md +16 -0
- package/dist/{13e6d1463f0aec440afa.json → 2bbc3428df6b8d66516c.json} +2 -2
- package/dist/agentic-security.mjs +2 -2
- package/dist/agentic-security.mjs.sha256 +1 -1
- package/package.json +2 -2
- package/src/dataflow/CLAUDE.md +1 -1
- package/src/dataflow/catalog-expanded.js +5 -1
- package/src/dataflow/engine.js +7 -0
- package/src/language/CLAUDE.md +1 -0
- package/src/language/haskell-guards.js +10 -0
- package/src/language/haskell-ir.js +118 -2
- package/src/language/haskell-models.js +5 -0
- package/src/language/haskell-parser.js +4 -1
- package/src/language/haskell-syntax.js +34 -6
- package/src/posture/corpus-match.js +12 -0
|
@@ -1 +1 @@
|
|
|
1
|
-
|
|
1
|
+
a5a29b34945782b9200c9eb7e7733f276e168ba3c4a8a4033bc4e4dd3d8b1877 agentic-security.mjs
|
package/package.json
CHANGED
|
@@ -1,6 +1,6 @@
|
|
|
1
1
|
{
|
|
2
2
|
"name": "@clear-capabilities/agentic-security-scanner",
|
|
3
|
-
"version": "0.195.
|
|
3
|
+
"version": "0.195.12",
|
|
4
4
|
"description": "Scanner engine for the agentic-security Claude Code plugin: SAST, SCA with reachability and CISA KEV, secrets, IaC, Haskell and Nix/NixOS, prompt-injection, MCP/agent-tool audit, authZ analysis, SBOM, compliance attestation, and more.",
|
|
5
5
|
"type": "module",
|
|
6
6
|
"main": "src/index.js",
|
|
@@ -93,7 +93,7 @@
|
|
|
93
93
|
"test:lineage": "node --test test/lineage/analysis-completion.test.js test/lineage/schema.test.js test/lineage/ids.test.js test/lineage/protection.test.js test/lineage/classification.test.js test/lineage/validate.test.js test/lineage/json-schema-parity.test.js test/lineage/flagship-fixture.test.js test/lineage/flagship-fixture-semantics.test.js test/lineage/field-identity.test.js test/lineage/engine-expr-resolver.test.js test/lineage/engine-walker.test.js test/lineage/engine-integration.test.js test/lineage/engine-receiver-identity.test.js test/lineage/summaries.test.js test/lineage/driver.test.js test/lineage/engine-provenance.test.js test/lineage/engine-provenance-interprocedural.test.js test/lineage/path-store.test.js test/lineage/path-query.test.js test/lineage/flow-grade.test.js test/lineage/source-registry.test.js test/lineage/sink-registry.test.js test/lineage/transform-catalog.test.js test/lineage/handling-analyzer.test.js test/lineage/registry-real-code.test.js test/lineage/source-seeding.test.js test/lineage/graph-builder.test.js test/lineage/coverage.test.js test/lineage/resolve-destination.test.js test/lineage/queue-detail.test.js test/lineage/index.test.js test/lineage/obligation-mapping.test.js test/lineage/obligation-predicates.test.js test/lineage/obligation-predicates-walkthrough.test.js test/lineage/transit-protection.test.js test/lineage/at-rest-protection.test.js test/lineage/protection-summary.test.js test/lineage/ac01-multi-sink.test.js test/lineage/policy-verdict.test.js test/lineage/governance-refs.test.js test/lineage/export-privacy.test.js test/lineage/export-json.test.js test/lineage/export-csv.test.js test/lineage/decision-story.test.js test/lineage/export-briefing.test.js test/lineage/graph-snapshot.test.js test/lineage/graph-diff.test.js test/lineage/drift-policy.test.js test/lineage/recipient-profile.test.js test/lineage/recipient-registry.test.js test/lineage/recipient-wiring.test.js test/lineage/redact-graph.test.js test/lineage-scan-wiring.test.js test/lineage-artifact-write.test.js test/bench-data-lineage-runner.test.js test/bundle-frontend.test.js test/bundle-frontend-golden.test.js test/generate-html-report.test.js test/export-image.test.js test/lineage/scenario.test.js test/lineage/scenario-engine.test.js test/lineage/scenario-diff.test.js test/lineage/scenario-no-obligation-wiring.test.js test/lineage/impact-assessment.test.js test/lineage/impact-engine.test.js test/lineage/impact-no-obligation-wiring.test.js test/lineage/governance-edit.test.js test/lineage/remediation.test.js test/lineage/runtime-observation.test.js test/lineage/observation-correlation.test.js test/lineage/observation-adapters.test.js test/lineage/observation-store.test.js test/lineage/runtime-corroboration-wiring.test.js test/lineage/cross-repo-link.test.js test/lineage/federation-loader.test.js test/lineage/cross-repo-link-wiring.test.js test/lineage/runtime-assurance.test.js test/lineage/runtime-edge-states.test.js test/lineage/runtime-explorer-view.test.js test/cli/runtime-explorer-cli.test.js test/cli/runtime-identity-cli.test.js test/cli/runtime-twin-cli.test.js test/lineage/cut-planner.test.js test/lineage/scc.test.js test/lineage/scc-solver.test.js test/graph/graph-views.test.js test/lineage/dag07-completion.test.js test/lineage/owned-build.test.js test/dataflow/boundary-propagation.test.js test/lineage/boundary-contract.test.js test/lineage/correlation-v2.test.js test/lineage/path-control-evidence.test.js test/lineage/smt-z3-backend.test.js test/cli/dag-commands.test.js",
|
|
94
94
|
"test:bench-modules": "node --test test/phase4-harness.test.js test/pipeline.test.js test/proof-corpus-lib.test.js test/proof-corpus-runner.test.js",
|
|
95
95
|
"test:server": "node --test test/server/graph-loader.test.js test/server/security.test.js test/server/routes.test.js test/server/http-server.test.js test/server/cmd-explore.test.js test/server/cmd-dataflow-export.test.js test/server/static-assets.test.js test/server/dataflow-scenario-cli.test.js test/server/dataflow-impact-cli.test.js",
|
|
96
|
-
"test:haskell": "node --test test/haskell/haskell-reachability.test.js test/haskell/haskell-real-code-shapes.test.js test/haskell/haskell-unseen-v5-shapes.test.js test/haskell/haskell-unseen-v4-shapes.test.js test/haskell/haskell-alias-taint.test.js test/haskell/haskell-weak-hash-names.test.js test/haskell/haskell-models-extended.test.js test/haskell/haskell-rules-extended.test.js test/haskell/haskell-injection.test.js test/haskell/haskell-ir.test.js test/haskell/haskell-manifests.test.js test/haskell/haskell-parser.test.js test/haskell/haskell-remediation.test.js test/haskell/haskell-remediation-0190.test.js test/haskell/haskell-remediation-kdf.test.js test/haskell/haskell-remediation-html-text.test.js test/haskell/haskell-remediation-scotty-body.test.js test/haskell/haskell-taint-shapes.test.js test/haskell/haskell-resolved-graph.test.js test/haskell/haskell-sca.test.js test/haskell/haskell-sca-severity.test.js test/haskell/haskell-web-guards.test.js test/haskell/haskell-advisory-feed.test.js test/haskell/haskell-security-rules.test.js test/haskell/haskell-taint.test.js test/haskell/haskell-boundaries.test.js test/haskell/haskell-live-feed-scan.test.js test/haskell/haskell-supply-bounds.test.js test/haskell/haskell-ir-scaling.test.js test/haskell/haskell-boundary-propagation.test.js test/haskell/haskell-generalization.test.js test/haskell/haskell-trust-boundary.test.js test/haskell/haskell-comment-invariance.test.js test/haskell/haskell-remediation-classes.test.js test/haskell/haskell-trust-boundary-frameworks.test.js test/haskell/haskell-generic-detectors.test.js",
|
|
96
|
+
"test:haskell": "node --test test/haskell/haskell-reachability.test.js test/haskell/haskell-real-code-shapes.test.js test/haskell/haskell-unseen-v5-shapes.test.js test/haskell/haskell-unseen-v4-shapes.test.js test/haskell/haskell-alias-taint.test.js test/haskell/haskell-weak-hash-names.test.js test/haskell/haskell-models-extended.test.js test/haskell/haskell-rules-extended.test.js test/haskell/haskell-injection.test.js test/haskell/haskell-ir.test.js test/haskell/haskell-manifests.test.js test/haskell/haskell-parser.test.js test/haskell/haskell-remediation.test.js test/haskell/haskell-remediation-0190.test.js test/haskell/haskell-remediation-kdf.test.js test/haskell/haskell-remediation-html-text.test.js test/haskell/haskell-remediation-scotty-body.test.js test/haskell/haskell-taint-shapes.test.js test/haskell/haskell-real-advisory-shapes.test.js test/haskell/haskell-resolved-graph.test.js test/haskell/haskell-sca.test.js test/haskell/haskell-sca-severity.test.js test/haskell/haskell-web-guards.test.js test/haskell/haskell-advisory-feed.test.js test/haskell/haskell-security-rules.test.js test/haskell/haskell-taint.test.js test/haskell/haskell-boundaries.test.js test/haskell/haskell-live-feed-scan.test.js test/haskell/haskell-supply-bounds.test.js test/haskell/haskell-ir-scaling.test.js test/haskell/haskell-boundary-propagation.test.js test/haskell/haskell-generalization.test.js test/haskell/haskell-trust-boundary.test.js test/haskell/haskell-comment-invariance.test.js test/haskell/haskell-remediation-classes.test.js test/haskell/haskell-trust-boundary-frameworks.test.js test/haskell/haskell-generic-detectors.test.js",
|
|
97
97
|
"test:nix": "node --test test/nix/nix-option-types.test.js test/nix/nix-development-shapes.test.js test/nix/nixos-hardening-daemon.test.js test/nix/nixos-hardening-extended.test.js test/nix/nix-build-trust.test.js test/nix/nix-eval-isolation.test.js test/nix/nix-input-inventory.test.js test/nix/nix-parser-ir.test.js test/nix/nix-remediation.test.js test/nix/nix-resolved-closure.test.js test/nix/nix-sca-patches.test.js test/nix/nix-sca-severity.test.js test/nix/nix-haskell-closure-names.test.js test/nix/nix-script-taint.test.js test/nix/nix-secrets-store.test.js test/nix/nixos-hardening.test.js test/nix/nixos-module-resolution.test.js test/nix/nix-fix-multifile.test.js test/nix/nixos-evaluator-forms.test.js test/nix/nix-advisory-feed.test.js test/nix/nix-fix-prewrite.test.js test/nix/nix-boundary-scope.test.js",
|
|
98
98
|
"test:language": "node --test test/bench-haskell-precision.test.js test/bench-independent-haskell-panel.test.js test/language/capability-ledger.test.js test/language/language-accuracy-regression.test.js test/language/language-aibom.test.js test/language/language-assurance.test.js test/language/language-bom.test.js test/language/language-compliance.test.js test/language/language-contracts.test.js test/language/language-corpora-integrity.test.js test/language/language-discovery.test.js test/language/language-doc-coverage.test.js test/language/language-evidence-posture.test.js test/language/language-explorer.test.js test/language/frozen-splits.test.js test/language/language-gap-fixes.test.js test/language/language-gap-fixes-2.test.js test/language/language-governance.test.js test/language/language-integrations.test.js test/language/language-llm-agent.test.js test/language/language-local-ai.test.js test/language/language-parity-haskell.test.js test/language/language-polyglot-bridges.test.js test/language/language-privacy-lineage.test.js test/language/language-proof-remediation.test.js test/language/language-report-formats.test.js test/language/language-secrets.test.js test/language/language-trust-boundary.test.js",
|
|
99
99
|
"test:language-stress": "node --test --test-concurrency=1 test/language/language-stress-offline.test.js",
|
package/src/dataflow/CLAUDE.md
CHANGED
|
@@ -196,4 +196,4 @@ member-based: `hs-src-caller-controlled-param` (a text parameter of an exported
|
|
|
196
196
|
catalog entries and requires a markup literal for `htmlSkeleton` sinks. Pinned counts in the lineage registry tests change
|
|
197
197
|
deliberately when the model registry grows. Details: `scanner/src/language/CLAUDE.md`.
|
|
198
198
|
|
|
199
|
-
|
|
199
|
+
Four Haskell-scoped behaviours live in `engine.js` (all guarded by `_currentFile` being a `.hs`/`.lhs` file, so no other language changes): a `union` (the branches of an `if`, a `case`, guards) handed to another call as an argument (`get "/p" $ do .. case m of A -> sink x`) or bound as a statement is a sink site in EACH branch (`_nestedSinkFindings`; the `assign` case); a tuple or constructor application (an `array` with `hs.tuple`/`hs.con`) handed to a call is walked like an argument list, so a sink built inside `return (settings, Con (sink ..))` is a site (found on keter, `bench/cve-replay/real-haskell-advisories.md`); `exprTaint` of a `member` whose object is a call result (the elements of `words s`) is the object's taint; and the catalog gains four annotation sources, `hs-src-handler-param-<framework>` (a text parameter of an exported function that returns a Scotty/Yesod/Servant/WAI handler value: request input, provenance `url-param`), beside the weaker `hs-src-caller-controlled-param`.
|
|
@@ -329,7 +329,11 @@ const JAVA_SHELL = [
|
|
|
329
329
|
const JAVA_URL_PATH_REGEX = [
|
|
330
330
|
san('java', 'url', 'URLEncoder.encode', ['url']),
|
|
331
331
|
san('java', 'uri', 'URI', ['url']),
|
|
332
|
-
|
|
332
|
+
// `Paths.get` only BUILDS a Path: a `..` segment in its argument survives into the file operation, so it neutralises nothing. It was
|
|
333
|
+
// listed as a path sanitizer, which made the engine PROVE the Spring path traversal `CVE-2018-1271-java-path-traversal` clean ("sanitized
|
|
334
|
+
// via Paths.get"); that false proof was hidden while the corpus scored a proven-clean finding as a detection, and showed the moment
|
|
335
|
+
// `posture/corpus-match.js` stopped counting refuted findings. (`Path.normalize` alone does not contain a path either, but with a
|
|
336
|
+
// `startsWith` check it is the guard `dropGuardedFindings` recognises; it stays listed, demoting only.)
|
|
333
337
|
san('java', 'nio', 'Path.normalize', ['path']),
|
|
334
338
|
san('java', 'regex', 'Pattern.quote', ['regex']),
|
|
335
339
|
];
|
package/src/dataflow/engine.js
CHANGED
|
@@ -1443,6 +1443,13 @@ function _nestedSinkFindings(argExprs, state, callContext, line) {
|
|
|
1443
1443
|
findings.push(..._nestedSinkFindings(leaves, state, callContext, line));
|
|
1444
1444
|
continue;
|
|
1445
1445
|
}
|
|
1446
|
+
// Haskell: a tuple or a constructor application is an `array` (`hs.tuple` / `hs.con`); a call built inside it runs when the value is built,
|
|
1447
|
+
// so `return (settings, WPRResponse (responseBuilder .. body))` carries the sink in its second component (real code, keter: the reverse
|
|
1448
|
+
// proxy's unknown-host page). The elements are walked like arguments; the other IRs never put a sink call inside an array literal this way.
|
|
1449
|
+
if (arg && arg.kind === 'array' && arg.hs && (arg.hs.tuple || arg.hs.con) && /\.(?:hs|lhs)$/i.test(_currentFile || '')) {
|
|
1450
|
+
findings.push(..._nestedSinkFindings(arg.elements, state, callContext, line));
|
|
1451
|
+
continue;
|
|
1452
|
+
}
|
|
1446
1453
|
if (!arg || arg.kind !== 'call') continue;
|
|
1447
1454
|
const { cat, argTaints } = _matchCallCatalog(arg.callee, arg.args, state, callContext);
|
|
1448
1455
|
const at = _sinkLine(arg, line);
|
package/src/language/CLAUDE.md
CHANGED
|
@@ -66,6 +66,7 @@ or a capability.** Product-facing guides: `docs/guides/haskell.md`, `docs/guides
|
|
|
66
66
|
- **Guards are recognised by what they do.** `haskell-guards.js`: a project function is an HTML escaper when it (or its local helpers) spells out the entities for `<`, `>` and `&` (`htmlEscapers`; never by name), and it neutralises a CWE-79 flow only when EVERY use of the value in the sink argument is under such a call (`allUsesEscaped`); a host allow-list may be a named constant and may sit in an `&&`; `sh -c SCRIPT arg0 arg1` is shell injection only when the SCRIPT is built from the value, and tainted positional parameters are data when the constant script expands them only inside double quotes after `--` (`quotedPositionals`, which decodes the Haskell string escapes the IR keeps raw).
|
|
67
67
|
- **Handlers named by the framework's convention are routes.** `haskell-web.js` adds `getFooR`/`postFooR`/`handleFooR` functions whose signature mentions `Handler` in a module importing Yesod when no route table in an analysed file names them (the table usually lives in `config/routes`). Scotty's rejection order is judged by `inlineOrder` as well as by line: a `case` lists the success branch first, so `status 40x >> finish` in the LAST alternative guards it (a bare `status` with no halting call does not).
|
|
68
68
|
- **A project definition of a modelled name keeps the registry's meaning (since 0.195.11).** `haskell-ir.js` `applyVar`/`lowerVarValue`: a resolution to a project `def` whose module-qualified name `isKnownApi` (the project IS the framework, or vendors it) is lowered as the LIBRARY call (`hs.status: 'external'`, `hs.modelledDefinition: qid`) and the definition is still referenced (`noteRef(..., 'modelled-definition')`, so it is never an uncalled entry point). Before this, IHP's own `IHP.Controller.Param.param` shadowed the catalog when IHP scanned itself, and a request parameter reaching `Process.system` through a helper was not reported (four lost true positives on the fresh set). A test stub named like a catalog module gets the same treatment, which is why the html-text remediation test keeps its scotty stub out of the scan. Pinned both ways in `test/haskell/haskell-taint-shapes.test.js`, with the three shapes below.
|
|
69
|
+
- **Shapes from the real code behind published advisories (since 0.195.12; `bench/cve-replay/real-haskell-advisories.md`, pinned in `test/haskell/haskell-real-advisory-shapes.test.js`).** `haskell-syntax.js`: a record pattern accepts whitespace before its brace (`Con {..}`; a `{` after a constructor inside a pattern is always a record pattern), a top-level `|` after an `of`, a `\case` or a multiway `if` inside a list literal is that construct's guard and not a comprehension bar, a `$(..)`/`$$(..)`/`$name` in prefix position is one `splice` token when the module's LANGUAGE pragma enables TemplateHaskell (`TH_PRAGMA`; a cabal `default-extensions` entry is not seen, a stated limit) and `aexp` reads it as an opaque `{t:'splice'}` atom (the IR lowers it to an unknown value without a lowering-gap diagnostic, the parser's `th-splice` boundary already discloses it), and `var@Pat = ..` in a declaration is a pattern binding, not a function named by the variable. `haskell-parser.js`: the Hamlet replacement closes its parenthesis at the `|]` (it used to go after the last `}`, a newline when the interpolation ended its line, so the paren was lost and the function failed to parse). `haskell-ir.js`: `fieldFunctionCandidates(con, field)` (the project class) indexes the function values every construction of `con` stores in `field` (`Con { f = g }`, `Con{..}` with `f <- pure g` / `f = g` in the building clause, `case`/`if` branches, `pure`/`return` peeled, `const <$> e` / `fmap const e` / `const e` as `ignores`; a lambda or anything else is `opaque`); a record-pattern-bound variable remembers its field (`{kind:'local', field:{con,name}}`, set in `bindPattern`) and `applyFieldCandidates` lowers the application as the union over the candidates (names applied in the module of the construction, `ignores` as an unknown value not derived from the arguments), only when NO candidate is opaque. `dataflow/engine.js` `_nestedSinkFindings` walks the elements of a Haskell tuple or constructor `array` (`hs.tuple`/`hs.con`) like arguments, so a sink built inside `return (a, Con (sink ..))` is a site. `haskell-guards.js` `waiHtmlContext` returns `redirect` for a header list with `Location` and no content type and the finding is lowered to info (`redirect-response-body`). `haskell-models.js`: blaze-builder's HTML escapers are xss sanitizers (names read from the Hackage index, `tested: ['0.4.4']`). `posture/corpus-match.js` scores neither a `proven-*` finding nor an `info` finding with a `guardNote` (see `bench/cve-replay/CONTRIBUTING.md`).
|
|
69
70
|
- **Mutable cells, instance dispatch, functions in record fields (since 0.195.11).** `haskell-ir.js`: `CELL_OPS` lowers `writeIORef ref v` (MVar, TVar, STRef alike) to an assignment of the cell's local variable, a read to that variable, `modifyIORef ref f` to `ref = f ref` (`lowerCellOp`; only a cell held in a local variable, never across functions, disclosed in the guide). `dispatchInstance`: a class-method call with a constructor argument of a type that has exactly one visible instance resolves to that instance method (`hs.status: 'resolved'`, `hs.dispatchedOn`); instance functions are now named `Mod.$inst.Class.Type.method` (`instanceMeta`, `instanceTypeOf` reads the instance head) so two instances of one class resolve to different functions by name, which the dataflow engine needs because it resolves callees by name. `heldFieldFunction`: `exec ops x` with `ops` a top-level constant record literal applies the field's expression (lambda or name), lowered in the constant's module with the arguments lowered in the caller's. The cell and STM names are in `HS_RULE_APIS` so wildcard imports qualify them.
|
|
70
71
|
- **IR idioms that must keep the action.** `m >>= \_ -> k` and `f <$> m` RUN `m` even when the lambda ignores its result (`betaReduce`, `via`); `maybe d f m` / `either f g e` are a two-way branch on the scrutinee (so the scrutinee is still examined); `\case` applied by `>>=` is a case run in place; `foldM`, `zipWithM_`, `uncurry`, `fst`/`snd`/`const` of a written-out tuple, `filter isAlphaNum`, and a let-bound lambda (`let go = \x -> ..`, treated as `go x = ..`) are lowered so their sinks are reached. The taint engine (`dataflow/engine.js`) is Haskell-scoped for three of these: a `union` handed to a combinator or bound as a statement is a sink site in each branch (`_nestedSinkFindings`, the `assign` case), and a `member` whose object is a call (the elements of `words s`) carries its object's taint.
|
|
71
72
|
- **A Haskell taint finding says who controls its input.** `haskell-trust.js` `applyTrustBoundary` (run in `engine.js` right after `applyHaskellGuards`) reads the origins the engine recorded (`sourceRoots`, or the evidence chain) and stamps `trustBoundary {verdict, reason, role, roots}`. Verdicts: `attacker-reachable` (request, socket, header, cookie, remote response; never lowered), `operator-controlled` (cli/env roots, and file-read roots in a command-line program; also an EMPTY origin in a command-line program, marked `inferred: true`), `api-contract` (a bare/whole-handoff parameter of an uncalled exported function reaching a process or, since 0.195.9, a path operation: CWE-78/88/22), `entry-parameter`, `data-input`, `unattributed`. `operator-controlled` and `api-contract` are lowered to `info` (never dropped; `originalSeverity`, `controls`, `guardNote` kept), the same convention `haskell-guards.js` uses. **Standard input is covered by the command-line rule only for a path operation** (since 0.195.9: a command-line program reading a file NAME from its standard input is the operator naming a file, 14 of the 29 flagged path sites on the real-code sets; `getLine >>= callCommand` in `main` stays reported, pinned in `test/haskell/haskell-trust-boundary.test.js`). **Path wrappers became `api-contract` in 0.195.9**: `withFile name WriteMode` on a caller-named file is the vulnerable shape of three synthetic development splits and of no real-code true positive, while `renderFile path = responseFile .. path` was a flagged false positive on every real project that had it; the parameter under a fixed directory (`"/srv/" ++ name`) is still `entry-parameter` and still a finding. That is a decision against the synthetic labels, taken on the real-code sets; the development-set numbers that moved are recorded in the changelog. The role is `fn.hs.entryRole` from `assignEntryRoles` in `haskell-ir.js`: `cli` (reached only from `main`s whose reachable modules import no server framework or socket library), `service`, or `library` (no `main` reaches it; an incomplete call graph therefore yields `library`, never `cli`). Pinned both ways in `test/haskell/haskell-trust-boundary.test.js`.
|
|
@@ -549,6 +549,9 @@ export function waiHtmlContext(f, perFile) {
|
|
|
549
549
|
const types = texts.filter((t) => /^(?:text|application|image|audio|video|multipart)\/[\w.+-]+/i.test(t.trim()));
|
|
550
550
|
if (types.some((t) => /^text\/html/i.test(t.trim()))) return 'html';
|
|
551
551
|
if (types.length) return 'other';
|
|
552
|
+
// A `Location` header and no content type: a redirect, whose body a browser never renders (keter's redirect helper echoes the target
|
|
553
|
+
// URL as the body of its 3xx response; that is a redirect finding's business, not an HTML injection).
|
|
554
|
+
if (texts.some((t) => /^location$/i.test(t.trim()))) return 'redirect';
|
|
552
555
|
return 'unknown';
|
|
553
556
|
}
|
|
554
557
|
return 'unknown';
|
|
@@ -636,6 +639,13 @@ export function applyHaskellGuards(findings, perFile) {
|
|
|
636
639
|
stats.weak++;
|
|
637
640
|
continue;
|
|
638
641
|
}
|
|
642
|
+
if (ctx === 'redirect' && !f._notHtmlContext) {
|
|
643
|
+
f._notHtmlContext = true; f.severity = 'info';
|
|
644
|
+
f.controls = [...(f.controls || []), { kind: 'redirect-response-body', evidenceKind: 'source' }];
|
|
645
|
+
f.guardNote = { kind: 'redirect-response-body', reason: 'the response headers written at this call set Location and no content type: a redirect, whose body a browser does not render' };
|
|
646
|
+
stats.weak++;
|
|
647
|
+
continue;
|
|
648
|
+
}
|
|
639
649
|
if (ctx === 'unknown' && !f._htmlContextUnknown) { f._htmlContextUnknown = true; f.uncertainty = [...(f.uncertainty || []), { kind: 'unread-content-type', detail: 'the response headers at this call are not literal text, so whether the body is served as HTML was not read' }]; }
|
|
640
650
|
} catch { /* judged below */ }
|
|
641
651
|
try {
|
|
@@ -589,6 +589,9 @@ class FnLowerer {
|
|
|
589
589
|
for (const r of refs) this.noteRef(r, 'section', ln);
|
|
590
590
|
return { kind: 'array', elements: [this.lowerExpr(e.e, ln)], hs: { section: e.op, partial: { remaining: 1 } } };
|
|
591
591
|
}
|
|
592
|
+
// A Template Haskell splice in expression position: generated code the analysis never sees. The parser has already disclosed the
|
|
593
|
+
// `th-splice` boundary for the module, so this is not a lowering gap of the IR; the value is unknown.
|
|
594
|
+
case 'splice': return unknownExpr({ splice: true });
|
|
592
595
|
default: this.diagnostics.push({ kind: 'lowering-gap', detail: e.t || 'unknown' }); return unknownExpr({ ast: e.t || 'unknown' });
|
|
593
596
|
}
|
|
594
597
|
}
|
|
@@ -728,9 +731,18 @@ class FnLowerer {
|
|
|
728
731
|
try { return this.lowerApp(held.expr, lowered, ln, via); } finally { this.mod = savedMod; this.lineOverride = savedOverride; this.inlineDepth -= 1; }
|
|
729
732
|
}
|
|
730
733
|
const obj = this.lowerExpr(argAsts[0], ln);
|
|
734
|
+
if (argAsts.length > 1) {
|
|
735
|
+
const viaField = this.applyFieldCandidates(r.def.con, r.name, argAsts.slice(1), ln, via);
|
|
736
|
+
if (viaField) return viaField;
|
|
737
|
+
}
|
|
731
738
|
const mem = { kind: 'member', object: obj, prop: r.name };
|
|
732
739
|
return argAsts.length === 1 ? mem : { kind: 'call', callee: '<indirect>', args: [mem, ...argAsts.slice(1).map((a) => this.lowerExpr(a, ln))], hs: { status: 'unknown', reason: 'field-applied' } };
|
|
733
740
|
}
|
|
741
|
+
// `psUnkownHost host` where `psUnkownHost` was bound by a record pattern: the functions the project stores in that field.
|
|
742
|
+
if (r.kind === 'local' && r.field && argAsts.length) {
|
|
743
|
+
const viaField = this.applyFieldCandidates(r.field.con, r.field.name, argAsts, ln, via);
|
|
744
|
+
if (viaField) return viaField;
|
|
745
|
+
}
|
|
734
746
|
const viaAlias = this.applyAlias(r, argAsts, ln, via);
|
|
735
747
|
if (viaAlias) return viaAlias;
|
|
736
748
|
let args = argAsts.map((a) => this.lowerExpr(a, ln));
|
|
@@ -860,6 +872,31 @@ class FnLowerer {
|
|
|
860
872
|
return { mod, expr: fld.e };
|
|
861
873
|
}
|
|
862
874
|
|
|
875
|
+
// A function held in a record field whose record is NOT a top-level constant (a parameter bound by `Con {..}`, a record built at run time):
|
|
876
|
+
// the application is the union of the functions the project stores in that field, found in every construction of the constructor
|
|
877
|
+
// (`Con { f = g }`, or `Con{..}` with `f <- pure g` / `f = g` in the building function; a `case`/`if` chooses among them; `pure`/`return` is
|
|
878
|
+
// peeled; `const <$> e` / `const e` is a function that ignores its argument). Any construction whose value cannot be classified (a lambda
|
|
879
|
+
// with captured locals, an arbitrary expression) leaves the call unresolved as before: a partial answer would hide a sink or invent one.
|
|
880
|
+
applyFieldCandidates(con, field, argAsts, ln, via) {
|
|
881
|
+
if (!con || !field || (this.inlineDepth || 0) >= INLINE_MAX_DEPTH) return null;
|
|
882
|
+
const cands = this.proj.fieldFunctionCandidates(con, field);
|
|
883
|
+
if (!cands.length || cands.some((c) => c.kind === 'opaque')) return null;
|
|
884
|
+
const lowered = argAsts.map((a) => ({ t: 'lowered', expr: this.lowerExpr(a, ln) }));
|
|
885
|
+
let out = null;
|
|
886
|
+
for (const c of cands) {
|
|
887
|
+
let v;
|
|
888
|
+
if (c.kind === 'ignores') v = unknownExpr({ fieldFunction: `${con}.${field}`, ignoresArguments: true });
|
|
889
|
+
else {
|
|
890
|
+
const savedMod = this.mod; const savedOverride = this.lineOverride;
|
|
891
|
+
this.lineOverride = this.lineOverride || ln; this.inlineDepth = (this.inlineDepth || 0) + 1; this.mod = c.mod;
|
|
892
|
+
try { v = this.lowerApp(c.expr, lowered, ln, via); } finally { this.mod = savedMod; this.lineOverride = savedOverride; this.inlineDepth -= 1; }
|
|
893
|
+
}
|
|
894
|
+
out = mkUnion(out, v);
|
|
895
|
+
}
|
|
896
|
+
if (out) out.hs = { ...(out.hs || {}), fieldFunction: `${con}.${field}`, candidates: cands.length };
|
|
897
|
+
return out;
|
|
898
|
+
}
|
|
899
|
+
|
|
863
900
|
// A mutable cell held in a local variable (see CELL_OPS): a write is an assignment of the cell's variable, a read is that variable, a modify is
|
|
864
901
|
// the function applied to it. Anything else (a cell that is not a local variable, a missing argument) is the plain call.
|
|
865
902
|
lowerCellOp(callee, args, argAsts, ln, call) {
|
|
@@ -1202,8 +1239,10 @@ class FnLowerer {
|
|
|
1202
1239
|
const info = this.mod.cons.get(pat.con) || this.proj.findCon(pat.con);
|
|
1203
1240
|
pat.args.forEach((x, i) => walk(x, { kind: 'member', object: s, prop: info && info.fields && info.fields[i] ? info.fields[i] : `${pat.con}.${i}` }));
|
|
1204
1241
|
for (const f of pat.fields) {
|
|
1205
|
-
|
|
1206
|
-
|
|
1242
|
+
// A variable bound to a record field (`MkProxySettings {..}`, `Ops { exec = run }`) remembers which field it is, so applying it can be
|
|
1243
|
+
// resolved to the functions the project stores in that field (see applyFieldCandidates).
|
|
1244
|
+
if (f.wildcard) { for (const fld of (info && info.fields) || []) if (!pat.fields.some((g) => g.name === fld)) { emit(fld, { kind: 'member', object: s, prop: fld }); this.declare(fld, { kind: 'local', field: { con: pat.con, name: fld } }); } }
|
|
1245
|
+
else { walk(f.pat, { kind: 'member', object: s, prop: f.name }); if (f.pat && f.pat.t === 'pvar') this.declare(f.pat.name, { kind: 'local', field: { con: pat.con, name: f.name } }); }
|
|
1207
1246
|
}
|
|
1208
1247
|
break;
|
|
1209
1248
|
}
|
|
@@ -1451,6 +1490,83 @@ class Project {
|
|
|
1451
1490
|
return this._recTypes;
|
|
1452
1491
|
}
|
|
1453
1492
|
|
|
1493
|
+
// The function values the project stores in field `field` of constructor `con`, over every construction in every module (see
|
|
1494
|
+
// applyFieldCandidates). Each candidate is `{kind:'name', mod, expr}` (a name resolved where the construction is), `{kind:'ignores'}`
|
|
1495
|
+
// (`const <$> e`, `fmap const e`, `const e`: the function ignores its argument) or `{kind:'opaque'}`. Bounded by a node budget per module.
|
|
1496
|
+
fieldFunctionCandidates(con, field) {
|
|
1497
|
+
const key = `${con}.${field}`;
|
|
1498
|
+
if (!this._fieldCands) this._fieldCands = new Map();
|
|
1499
|
+
if (this._fieldCands.has(key)) return this._fieldCands.get(key);
|
|
1500
|
+
const out = [];
|
|
1501
|
+
const walkAst = (n, visit, budget) => {
|
|
1502
|
+
if (!n || typeof n !== 'object' || budget.n-- <= 0) return;
|
|
1503
|
+
if (Array.isArray(n)) { for (const x of n) walkAst(x, visit, budget); return; }
|
|
1504
|
+
if (typeof n.t === 'string') visit(n);
|
|
1505
|
+
for (const k of Object.keys(n)) { const v = n[k]; if (v && typeof v === 'object') walkAst(v, visit, budget); }
|
|
1506
|
+
};
|
|
1507
|
+
// The expression bound to `name` inside the clause: a do-bind (`name <- e`), a `let`/`where` clause without parameters, or a pattern binding.
|
|
1508
|
+
const bindingOf = (clause, name) => {
|
|
1509
|
+
let found = null;
|
|
1510
|
+
walkAst(clause, (n) => {
|
|
1511
|
+
if (found) return;
|
|
1512
|
+
if (n.t === 'sbind' && n.pat && n.pat.t === 'pvar' && n.pat.name === name) found = { e: n.e, bind: true };
|
|
1513
|
+
else if (n.t === 'clause' && n.name === name && n.clause && !n.clause.pats.length && n.clause.rhs && n.clause.rhs.body && !(n.clause.rhs.guards && n.clause.rhs.guards.length)) found = { e: n.clause.rhs.body };
|
|
1514
|
+
else if (n.t === 'patbind' && n.pat && n.pat.t === 'pvar' && n.pat.name === name && n.rhs && n.rhs.body) found = { e: n.rhs.body };
|
|
1515
|
+
}, { n: 20000 });
|
|
1516
|
+
return found;
|
|
1517
|
+
};
|
|
1518
|
+
const localsOf = (clause) => {
|
|
1519
|
+
const names = new Set();
|
|
1520
|
+
for (const p of clause.pats || []) for (const v of patternVars(p)) names.add(v);
|
|
1521
|
+
walkAst(clause, (n) => {
|
|
1522
|
+
if (n.t === 'sbind' && n.pat) for (const v of patternVars(n.pat)) names.add(v);
|
|
1523
|
+
else if (n.t === 'clause' && n.name) names.add(n.name);
|
|
1524
|
+
else if (n.t === 'lam') for (const p of n.params || []) for (const v of patternVars(p)) names.add(v);
|
|
1525
|
+
else if (n.t === 'patbind' && n.pat) for (const v of patternVars(n.pat)) names.add(v);
|
|
1526
|
+
}, { n: 20000 });
|
|
1527
|
+
return names;
|
|
1528
|
+
};
|
|
1529
|
+
const isVar = (e, name) => { const u = unparen(e); return u && u.t === 'var' && !u.qual && u.name === name; };
|
|
1530
|
+
const classify = (e, mod, locals, depth) => {
|
|
1531
|
+
const u = unparen(e);
|
|
1532
|
+
if (!u || depth > 6) { out.push({ kind: 'opaque' }); return; }
|
|
1533
|
+
if (u.t === 'var') {
|
|
1534
|
+
if (locals.has(u.name) && !u.qual) { out.push({ kind: 'opaque' }); return; }
|
|
1535
|
+
const r = resolveGlobal(this, mod, u.name, u.qual || null);
|
|
1536
|
+
if ((r.kind === 'def' && r.def.kind === 'fun') || r.kind === 'external' || r.kind === 'builtin') out.push({ kind: 'name', mod, expr: u });
|
|
1537
|
+
else out.push({ kind: 'opaque' });
|
|
1538
|
+
return;
|
|
1539
|
+
}
|
|
1540
|
+
if (u.t === 'op' && u.op === '$') { classify({ t: 'app', f: u.l, args: [u.r], line: u.line }, mod, locals, depth + 1); return; }
|
|
1541
|
+
if (u.t === 'op' && u.op === '<$>' && isVar(u.l, 'const')) { out.push({ kind: 'ignores' }); return; }
|
|
1542
|
+
if (u.t === 'app' && u.args.length === 1 && (isVar(u.f, 'pure') || isVar(u.f, 'return'))) { classify(u.args[0], mod, locals, depth + 1); return; }
|
|
1543
|
+
if (u.t === 'app' && isVar(u.f, 'fmap') && u.args.length === 2 && isVar(u.args[0], 'const')) { out.push({ kind: 'ignores' }); return; }
|
|
1544
|
+
if (u.t === 'app' && isVar(u.f, 'const') && u.args.length === 1) { out.push({ kind: 'ignores' }); return; }
|
|
1545
|
+
if (u.t === 'case') { for (const a of u.alts || []) { if (a.rhs && a.rhs.guards && a.rhs.guards.length) for (const g of a.rhs.guards) classify(g.body, mod, locals, depth + 1); else classify(a.rhs && a.rhs.body, mod, locals, depth + 1); } return; }
|
|
1546
|
+
if (u.t === 'if') { classify(u.a, mod, locals, depth + 1); classify(u.b, mod, locals, depth + 1); return; }
|
|
1547
|
+
out.push({ kind: 'opaque' });
|
|
1548
|
+
};
|
|
1549
|
+
for (const mod of this.modules.values()) {
|
|
1550
|
+
for (const f of (mod.groups && mod.groups.funs) || []) {
|
|
1551
|
+
for (const c of f.clauses || []) {
|
|
1552
|
+
const recs = [];
|
|
1553
|
+
walkAst(c, (n) => { if (n.t === 'rec' && n.con && n.con.name === con) recs.push(n); }, { n: 20000 });
|
|
1554
|
+
if (!recs.length) continue;
|
|
1555
|
+
const locals = localsOf(c);
|
|
1556
|
+
for (const r of recs) {
|
|
1557
|
+
const explicit = (r.fields || []).find((x) => !x.wildcard && x.name === field);
|
|
1558
|
+
if (explicit) { classify(explicit.e, mod, locals, 0); continue; }
|
|
1559
|
+
if (!(r.fields || []).some((x) => x.wildcard)) continue; // the field is not set here (a partial record): nothing is known about it
|
|
1560
|
+
const b = bindingOf(c, field);
|
|
1561
|
+
if (b) classify(b.e, mod, locals, 0); else out.push({ kind: 'opaque' });
|
|
1562
|
+
}
|
|
1563
|
+
}
|
|
1564
|
+
}
|
|
1565
|
+
}
|
|
1566
|
+
this._fieldCands.set(key, out);
|
|
1567
|
+
return out;
|
|
1568
|
+
}
|
|
1569
|
+
|
|
1454
1570
|
// A definition by its qid (the last one in module order wins, as the linear scan it replaces did).
|
|
1455
1571
|
defByQid(qid) {
|
|
1456
1572
|
if (!this._defIndex) {
|
|
@@ -42,6 +42,7 @@ export const HS_PACKAGES = Object.freeze({
|
|
|
42
42
|
'http-conduit': { modules: ['Network.HTTP.Simple', 'Network.HTTP.Conduit'], tested: ['2.3'] },
|
|
43
43
|
wreq: { modules: ['Network.Wreq', 'Network.Wreq.Session'], tested: ['0.5'] },
|
|
44
44
|
'blaze-html': { modules: ['Text.Blaze', 'Text.Blaze.Html', 'Text.Blaze.Html5', 'Text.Blaze.Internal'], tested: ['0.9'] },
|
|
45
|
+
'blaze-builder': { modules: ['Blaze.ByteString.Builder.Html.Utf8', 'Blaze.ByteString.Builder.Html.Word'], tested: ['0.4.4'] },
|
|
45
46
|
lucid: { modules: ['Lucid', 'Lucid.Base'], tested: ['2.11'] },
|
|
46
47
|
shakespeare: { modules: ['Text.Hamlet', 'Text.Shakespeare'], tested: ['2.0'] },
|
|
47
48
|
text: { modules: ['Data.Text', 'Data.Text.IO', 'Data.Text.Lazy', 'Data.Text.Lazy.IO', 'Data.Text.Encoding'], tested: ['2.0'] },
|
|
@@ -347,6 +348,10 @@ san('Text.Blaze', ['toMarkup', 'toValue', 'text', 'string', 'lazyText'], ['xss']
|
|
|
347
348
|
// Text.Blaze.Html5 and Html4 re-export the escaping combinators, and most files import the element module rather than Text.Blaze.Html
|
|
348
349
|
for (const mod of ['Text.Blaze.Html5', 'Text.Blaze.Html4.Strict', 'Text.Blaze.Html4.Transitional', 'Text.Blaze.Html4.FrameSet', 'Text.Blaze.XHtml5', 'Text.Blaze.XHtml1.Strict']) san(mod, ['toHtml', 'toMarkup', 'toValue', 'text', 'string', 'lazyText', 'textValue', 'stringValue'], ['xss'], 'escapes &, <, >, quotes for HTML text/attribute context');
|
|
349
350
|
san('Lucid', ['toHtml', 'toHtmlRaw_'], ['xss'], 'Lucid.toHtml escapes');
|
|
351
|
+
// blaze-builder's HTML escapers (names read from the 0.4.4.1 Haddock index): a raw WAI body built from them is escaped text. keter's fix for
|
|
352
|
+
// its reflected XSS (HSEC-2024-0001) is `toByteString . fromHtmlEscapedByteString` over the Host header.
|
|
353
|
+
san('Blaze.ByteString.Builder.Html.Utf8', ['fromHtmlEscapedChar', 'fromHtmlEscapedString', 'fromHtmlEscapedShow', 'fromHtmlEscapedText', 'fromHtmlEscapedLazyText'], ['xss'], 'escapes &, <, >, quotes for HTML text/attribute context', { package: 'blaze-builder' });
|
|
354
|
+
san('Blaze.ByteString.Builder.Html.Word', ['fromHtmlEscapedWord', 'fromHtmlEscapedWordList', 'fromHtmlEscapedByteString', 'fromHtmlEscapedLazyByteString'], ['xss'], 'escapes &, <, >, quotes for HTML text/attribute context', { package: 'blaze-builder' });
|
|
350
355
|
san('System.FilePath', ['takeFileName', 'takeBaseName'], ['path'], 'drops every directory component');
|
|
351
356
|
san('System.FilePath.Posix', ['takeFileName', 'takeBaseName'], ['path'], 'drops every directory component');
|
|
352
357
|
// A function whose result is a number or a boolean cannot carry caller text: nothing of the argument survives (`show (length x)`).
|
|
@@ -1131,7 +1131,10 @@ function analyze(source, file, dialect, ctx, res) {
|
|
|
1131
1131
|
put(it.exprStart, seg.slice(it.exprStart, it.close));
|
|
1132
1132
|
put(it.close, ')');
|
|
1133
1133
|
}
|
|
1134
|
-
|
|
1134
|
+
// Closes the application at the `|` of the closing `|]`: always inside the segment and never a newline. (It used to go at the character
|
|
1135
|
+
// after the last `}`, which is a newline when the interpolation ends its line, so the paren was dropped and the enclosing function failed
|
|
1136
|
+
// to parse: every hledger-web handler whose last `^{widget}` ended a line lost its calls.)
|
|
1137
|
+
put(seg.length - 2, ')');
|
|
1135
1138
|
const text = chars.join('');
|
|
1136
1139
|
if (text.length !== seg.length) continue;
|
|
1137
1140
|
b.kind = 'quasiquote-hamlet';
|
|
@@ -16,6 +16,8 @@ export class SyntaxBudgetError extends Error {}
|
|
|
16
16
|
const KW = new Set(['case', 'class', 'data', 'default', 'deriving', 'do', 'else', 'foreign', 'if', 'import', 'in', 'infix', 'infixl', 'infixr', 'instance', 'let', 'module', 'newtype', 'of', 'then', 'type', 'where']);
|
|
17
17
|
// An annotation naming a plain number or a boolean, alone or inside Maybe / IO / an action monad: a value of that type cannot carry caller text.
|
|
18
18
|
const NUMERIC_TYPE = /^\(?\s*(?:(?:Maybe|IO|ActionM|Handler|Either\s+String)\s+)?\(?\s*(?:Int|Integer|Int(?:8|16|32|64)|Word|Word(?:8|16|32|64)|Double|Float|Natural|Bool|Scientific)\s*\)?\s*\)?$/;
|
|
19
|
+
// The module enables Template Haskell (a LANGUAGE pragma; a cabal `default-extensions` entry is not seen here, a stated limit).
|
|
20
|
+
const TH_PRAGMA = /\{-#\s*LANGUAGE\b[^#]*\bTemplateHaskell\b/;
|
|
19
21
|
const RESERVED_OPS = new Set(['=', '|', '->', '<-', '::', '=>', '\\', '@', '~', '..']);
|
|
20
22
|
const SYM = new Set('!#$%&*+./<=>?@\\^|-~:'.split(''));
|
|
21
23
|
const OPEN = { '(': ')', '[': ']', '{': '}' };
|
|
@@ -30,9 +32,10 @@ const NUM = /0[xX][0-9a-fA-F_]+|0[oO][0-7_]+|0[bB][01_]+|\d[\d_]*(?:\.\d[\d_]*)?
|
|
|
30
32
|
* t is var|con|op|rop|kw|int|float|str|chr|sp. `first` is true for the first
|
|
31
33
|
* token on its line; `col` is the 0-based column with tabs at 8.
|
|
32
34
|
*/
|
|
33
|
-
export function lexHs(src) {
|
|
35
|
+
export function lexHs(src, opts = {}) {
|
|
34
36
|
const T = [];
|
|
35
37
|
const n = src.length;
|
|
38
|
+
const thSplices = !!opts.th;
|
|
36
39
|
let i = 0;
|
|
37
40
|
let line = 1;
|
|
38
41
|
let col = 0;
|
|
@@ -142,6 +145,14 @@ export function lexHs(src) {
|
|
|
142
145
|
push('sp', c, {}, 1);
|
|
143
146
|
continue;
|
|
144
147
|
}
|
|
148
|
+
// A Template Haskell splice in prefix position, `$(..)`, `$$(..)` or `$name`, with the extension on: one `splice` token, so the expression
|
|
149
|
+
// around it still parses (`pure (x, $(widgetFile "add-form"))`, real Yesod code). Without the extension `f $(g x)` is the ordinary `$`.
|
|
150
|
+
if (c === '$' && thSplices) {
|
|
151
|
+
const k = src[i + 1] === '$' ? i + 2 : i + 1;
|
|
152
|
+
const prev = i > 0 ? src[i - 1] : ' ';
|
|
153
|
+
const prefix = !(isIdChar(prev) || isSym(prev) || prev === ')' || prev === ']' || prev === '}' || prev === '"' || prev === "'");
|
|
154
|
+
if (prefix && (src[k] === '(' || (isIdStart(src[k]) && !isUpper(src[k])))) { push('splice', src.slice(i, k), {}, k - i); continue; }
|
|
155
|
+
}
|
|
145
156
|
if (isSym(c)) {
|
|
146
157
|
let j = i;
|
|
147
158
|
while (isSym(src[j])) j++;
|
|
@@ -185,7 +196,7 @@ const BT_FIX = { elem: [4, 'l'], notElem: [4, 'l'], div: [7, 'l'], mod: [7, 'l']
|
|
|
185
196
|
* @returns {{tokens:object[], module:object|null, imports:object[], decls:object[], sigs:object[], data:object[], classes:object[], instances:object[], errors:object[], boundaries:object[]}}
|
|
186
197
|
*/
|
|
187
198
|
export function parseSyntax(src, opts = {}) {
|
|
188
|
-
const T = lexHs(src);
|
|
199
|
+
const T = lexHs(src, { th: TH_PRAGMA.test(src) });
|
|
189
200
|
const mate = matchBrackets(T);
|
|
190
201
|
const N = T.length;
|
|
191
202
|
const errors = [];
|
|
@@ -317,7 +328,9 @@ export function parseSyntax(src, opts = {}) {
|
|
|
317
328
|
return [t.v === '_' ? { t: 'pwild' } : { t: 'pvar', name: t.v }, i + 1];
|
|
318
329
|
}
|
|
319
330
|
if (t.t === 'con') {
|
|
320
|
-
|
|
331
|
+
// A `{` after a constructor inside a pattern is always a record pattern (patterns have no record update and no explicit layout block), so
|
|
332
|
+
// `KeterConfig {..}` with a space before the brace is read like `KeterConfig{..}`. Real code (keter, hackage-server) writes the space.
|
|
333
|
+
if (isSp(T[i + 1], '{') && mate[i + 1] > i + 1) {
|
|
321
334
|
const close = mate[i + 1];
|
|
322
335
|
const fields = [];
|
|
323
336
|
for (const [s, e] of splitTop(i + 2, close, comma)) {
|
|
@@ -509,7 +522,7 @@ export function parseSyntax(src, opts = {}) {
|
|
|
509
522
|
function startsAexp() {
|
|
510
523
|
const t = peek();
|
|
511
524
|
if (!t) return false;
|
|
512
|
-
if (t.t === 'var' || t.t === 'con' || t.t === 'int' || t.t === 'float' || t.t === 'str' || t.t === 'chr') return true;
|
|
525
|
+
if (t.t === 'var' || t.t === 'con' || t.t === 'int' || t.t === 'float' || t.t === 'str' || t.t === 'chr' || t.t === 'splice') return true;
|
|
513
526
|
return isSp(t, '(') || isSp(t, '[');
|
|
514
527
|
}
|
|
515
528
|
function fexp() {
|
|
@@ -535,6 +548,13 @@ export function parseSyntax(src, opts = {}) {
|
|
|
535
548
|
else if (t.t === 'int' || t.t === 'float' || t.t === 'str' || t.t === 'chr') { pos++; e = { t: 'lit', kind: t.t, v: t.v, line: t.line }; }
|
|
536
549
|
else if (isSp(t, '(') && mate[pos] > pos && mate[pos] < lim) { const close = mate[pos]; e = parenExpr(pos, close); pos = close + 1; }
|
|
537
550
|
else if (isSp(t, '[') && mate[pos] > pos && mate[pos] < lim) { const close = mate[pos]; e = listExpr(pos, close); pos = close + 1; }
|
|
551
|
+
else if (t.t === 'splice') {
|
|
552
|
+
// The spliced code is generated at compile time: an opaque value here, disclosed by the parser's `th-splice` boundary.
|
|
553
|
+
pos++;
|
|
554
|
+
if (isSp(peek(), '(') && mate[pos] > pos && mate[pos] < lim) pos = mate[pos] + 1;
|
|
555
|
+
else if (peek() && peek().t === 'var') pos++;
|
|
556
|
+
return { t: 'splice', line: t.line };
|
|
557
|
+
}
|
|
538
558
|
else { err('unexpected-token', t, `unexpected token ${t.v}`); pos++; return { t: 'unknown', line: t.line }; }
|
|
539
559
|
while (isSp(peek(), '{') && mate[pos] > pos && mate[pos] < lim && (e.t === 'con' || e.t === 'var' || e.t === 'rec' || e.t === 'paren')) {
|
|
540
560
|
const close = mate[pos];
|
|
@@ -577,7 +597,14 @@ export function parseSyntax(src, opts = {}) {
|
|
|
577
597
|
const line = T[open].line;
|
|
578
598
|
if (a === close) return { t: 'list', items: [], line };
|
|
579
599
|
const bar = findTop(a, close, (x) => isRop(x, '|'));
|
|
580
|
-
|
|
600
|
+
// A `|` after a top-level `of` (case alternatives), `\case` or a multiway `if` inside the brackets is a guard of that construct, not the
|
|
601
|
+
// bar of a comprehension: `[ a, case m of { Nothing -> ""; Just p | p > 0 -> "" }, b ]` is a three-element list (real code, keter).
|
|
602
|
+
let guardOwner = false;
|
|
603
|
+
for (let i = a; bar > a && i < bar; i = Math.min(bar, groupEnd(i))) {
|
|
604
|
+
const x = T[i];
|
|
605
|
+
if (isKw(x, 'of') || (isRop(x, '\\') && isKw(T[i + 1], 'case')) || (isKw(x, 'if') && isRop(T[i + 1], '|'))) { guardOwner = true; break; }
|
|
606
|
+
}
|
|
607
|
+
if (bar > a && !guardOwner) {
|
|
581
608
|
const head = sub(a, bar, expr0);
|
|
582
609
|
const quals = splitTop(bar + 1, close, comma).map(([s, e]) => parseQual(s, e));
|
|
583
610
|
return { t: 'listcomp', head, quals, line };
|
|
@@ -689,7 +716,8 @@ export function parseSyntax(src, opts = {}) {
|
|
|
689
716
|
name = T[infixAt].v;
|
|
690
717
|
pats = [patRange(a, infixAt === infixEnd - 1 ? infixAt : infixAt), patRange(infixEnd, mark)];
|
|
691
718
|
if (isSp(T[infixAt - 1], '`')) pats[0] = patRange(a, infixAt - 1);
|
|
692
|
-
} else if (T[a].t === 'var' && !T[a].q) {
|
|
719
|
+
} else if (T[a].t === 'var' && !T[a].q && !(isRop(T[a + 1], '@') && T[a + 1].off === T[a].end)) {
|
|
720
|
+
// (`hooks@TLS.ServerHooks{..} = ...` is an as-pattern binding, handled as a pattern binding below, not a function named `hooks`.)
|
|
693
721
|
name = T[a].v;
|
|
694
722
|
for (let q = a + 1; q < mark;) {
|
|
695
723
|
const r = apatAt(q, mark);
|
|
@@ -47,9 +47,21 @@ function _any(scan, predicate) {
|
|
|
47
47
|
return false;
|
|
48
48
|
}
|
|
49
49
|
|
|
50
|
+
// A finding the scanner itself has PROVED clean (`proof.verdict` `proven-*`: the sink is reached only through a sanitizer that covers the
|
|
51
|
+
// finding's class, or only through a parameterizer) is a refuted report, not a detection: the fix lifecycle already drops it and the report
|
|
52
|
+
// marks it refuted. It scores on neither side, so a fix that sanitises through a recognised escaper reads as `post:TN` and a vulnerable
|
|
53
|
+
// shape the engine wrongly proves clean reads as `pre:FN`, both the honest direction. Added for the first real-advisory Haskell entry (keter,
|
|
54
|
+
// HSEC-2024-0001, whose fix is an HTML escaper); the full baseline was re-run and no synthetic entry's verdict moved.
|
|
55
|
+
function _refuted(f) { return !!(f && f.proof && typeof f.proof.verdict === 'string' && f.proof.verdict.startsWith('proven-')); }
|
|
56
|
+
// A finding at `info` with a guard note is one the engine lowered on evidence it read (a non-HTML content type, a redirect body, a fixed
|
|
57
|
+
// host): kept in the report so the lowering is visible, not a vulnerability it reports. It scores on neither side either. An `info`
|
|
58
|
+
// finding WITHOUT such a note (a rule that is informational by design) still scores, so no synthetic entry's verdict moves.
|
|
59
|
+
function _loweredOnEvidence(f) { return !!(f && f.severity === 'info' && f.guardNote && typeof f.guardNote === 'object'); }
|
|
60
|
+
|
|
50
61
|
// One predicate, both sides. See the header for why the symmetric form is the
|
|
51
62
|
// LOOSE one.
|
|
52
63
|
function _matches(f, manifest, matcher) {
|
|
64
|
+
if (_refuted(f) || _loweredOnEvidence(f)) return false;
|
|
53
65
|
return (matcher.test(f.vuln || '') || matcher.test(f.family || '')) &&
|
|
54
66
|
(manifest?.cwe ? f.cwe === manifest.cwe || matcher.test(f.cwe || '') : true);
|
|
55
67
|
}
|