From 092806946ca6e87875b032968e0cc3295977cc11 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Tue, 6 Oct 2026 22:02:22 +0100 Subject: [PATCH] chore(sanctify-php): resync vendored copy from upstream main fa9bd386 The vendored copy under rhodium-standard-repositories/.../cccp/satellites/ sanctify-php was 37 files and far behind upstream hyperpolymath/sanctify-php (182 files). Since #1181 the Haskell job builds every tracked package, and this copy cannot resolve: its .cabal pins base ^>=4.17 (GHC 9.4) while the job's GHC ships base-4.22. Upstream has since relaxed that to base >=4.17. Scoped resync, source = upstream origin/main fa9bd386 (read via git show, not a working tree): In: - every path the copy already tracked, made identical to upstream - deleted where upstream deleted them: 5 ISSUE_TEMPLATEs, comprehensive-quality.yml, LICENSE.txt (upstream ships LICENSE) - what the .cabal needs to build: src/, app/, bench/, test/*.hs, LICENSE Kept at the old vendored version, because upstream's copy fails one of this repo's own gates and editing vendored content to pass it is not ours to do. Neither plays any part in the build: - .github/dependabot.yml: upstream's has no SPDX header (validate-spdx) - .claude/CLAUDE.md: upstream's still names the retired 6a2/ path (check-canonical-names, AGENTS.md section 2a) Out, deliberately: - .machine_readable/ (holds a retired 6a2/ dir; and K9 contractiles that would enter standards' own K9 gates) - upstream's 13 newer workflows and .github/hooks - test/fixtures and test-plugins (deliberately vulnerable PHP) - www/, docs/ Local gates on this tree: Debtfile todo-fixme holds at 84, vendored-mirror-unpinned-actions falls 42 -> 40; check-lock-sync and check-allowed-actions pass. (gate-scripts-without-tests and the expired shell-scripts-missing-spdx acceptance are red on main too.) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_012kgrMQRhSmZMBbF9Ui1zBw --- .../.github/ISSUE_TEMPLATE/bug_report.md | 38 -- .../.github/ISSUE_TEMPLATE/custom.md | 10 - .../.github/ISSUE_TEMPLATE/documentation.md | 66 --- .../.github/ISSUE_TEMPLATE/feature_request.md | 20 - .../.github/ISSUE_TEMPLATE/question.md | 55 -- .../sanctify-php/.github/workflows/codeql.yml | 37 +- .../workflows/comprehensive-quality.yml | 226 -------- .../generator-generic-ossf-slsa3-publish.yml | 10 +- .../.github/workflows/governance.yml | 19 +- .../.github/workflows/haskell.yml | 16 +- .../sanctify-php/.github/workflows/mirror.yml | 7 +- .../.github/workflows/php-security.yml | 19 +- .../.github/workflows/scorecard.yml | 17 +- .../cccp/satellites/sanctify-php/.gitignore | 9 + .../cccp/satellites/sanctify-php/LICENSE | 373 +++++++++++++ .../cccp/satellites/sanctify-php/LICENSE.txt | 91 --- .../cccp/satellites/sanctify-php/README.adoc | 28 +- .../cccp/satellites/sanctify-php/app/Main.hs | 474 ++++++++++++++-- .../satellites/sanctify-php/bench/Main.hs | 174 ++++++ .../sanctify-php/sanctify-php.cabal | 78 ++- .../sanctify-php/src/Sanctify/AST.hs | 17 +- .../src/Sanctify/Analysis/Advanced.hs | 448 +++++++++++++++ .../src/Sanctify/Analysis/DeadCode.hs | 366 ++++++++++++ .../src/Sanctify/Analysis/Security.hs | 308 +++++++++-- .../src/Sanctify/Analysis/Taint.hs | 1 + .../src/Sanctify/Analysis/Types.hs | 477 +++------------- .../sanctify-php/src/Sanctify/Emit.hs | 218 +++++++- .../sanctify-php/src/Sanctify/Parser.hs | 496 ++--------------- .../sanctify-php/src/Sanctify/Parser/Lexer.hs | 4 + .../sanctify-php/src/Sanctify/Parser/Token.hs | 4 + .../sanctify-php/src/Sanctify/Report.hs | 1 + .../sanctify-php/src/Sanctify/Ruleset.hs | 445 +++++++++++++++ .../src/Sanctify/Transform/Sanitize.hs | 131 +++++ .../src/Sanctify/Transform/Strict.hs | 18 + .../src/Sanctify/Transform/TypeHints.hs | 11 +- .../src/Sanctify/WordPress/Constraints.hs | 1 + .../src/Sanctify/WordPress/Security.hs | 520 ++++++++++++++++++ .../sanctify-php/test/AspectSpec.hs | 203 +++++++ .../satellites/sanctify-php/test/E2ESpec.hs | 151 +++++ .../cccp/satellites/sanctify-php/test/Main.hs | 256 +++++++++ .../sanctify-php/test/ParserSpec.hs | 103 ++++ .../sanctify-php/test/PropertySpec.hs | 130 +++++ .../sanctify-php/test/SecuritySpec.hs | 150 +++++ .../cccp/satellites/sanctify-php/test/Spec.hs | 4 + .../sanctify-php/test/TransformSpec.hs | 223 ++++++++ 45 files changed, 4899 insertions(+), 1554 deletions(-) delete mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/bug_report.md delete mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/custom.md delete mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/documentation.md delete mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/feature_request.md delete mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/question.md delete mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/comprehensive-quality.yml create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE delete mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE.txt create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/bench/Main.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Advanced.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/DeadCode.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Lexer.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Token.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Ruleset.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Strict.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Security.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/AspectSpec.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/E2ESpec.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Main.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/ParserSpec.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/PropertySpec.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/SecuritySpec.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Spec.hs create mode 100644 rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/TransformSpec.hs diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/bug_report.md b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/bug_report.md deleted file mode 100644 index 987aab6bc..000000000 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/bug_report.md +++ /dev/null @@ -1,38 +0,0 @@ ---- -name: Bug report -about: Create a report to help us improve -title: "[Bug]: " -labels: 'bug, priority: unset, triage' -assignees: '' - ---- - -**Describe the bug** -A clear and concise description of what the bug is. - -**To Reproduce** -Steps to reproduce the behavior: -1. Go to '...' -2. Click on '....' -3. Scroll down to '....' -4. See error - -**Expected behavior** -A clear and concise description of what you expected to happen. - -**Screenshots** -If applicable, add screenshots to help explain your problem. - -**Desktop (please complete the following information):** - - OS: [e.g. iOS] - - Browser [e.g. chrome, safari] - - Version [e.g. 22] - -**Smartphone (please complete the following information):** - - Device: [e.g. iPhone6] - - OS: [e.g. iOS8.1] - - Browser [e.g. stock browser, safari] - - Version [e.g. 22] - -**Additional context** -Add any other context about the problem here. diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/custom.md b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/custom.md deleted file mode 100644 index 48d5f81fa..000000000 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/custom.md +++ /dev/null @@ -1,10 +0,0 @@ ---- -name: Custom issue template -about: Describe this issue template's purpose here. -title: '' -labels: '' -assignees: '' - ---- - - diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/documentation.md b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/documentation.md deleted file mode 100644 index 4fcb9f9fa..000000000 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/documentation.md +++ /dev/null @@ -1,66 +0,0 @@ ---- -name: Documentation -about: Report unclear, missing, or incorrect documentation -title: "[DOCS]: " -labels: 'documentation, priority: unset, triage' -assignees: '' - ---- - -name: Documentation -description: Report unclear, missing, or incorrect documentation -title: "[Docs]: " -labels: ["documentation", "triage"] -body: - - type: markdown - attributes: - value: | - Help us improve our documentation by reporting issues or gaps. - - - type: dropdown - id: type - attributes: - label: Documentation issue type - options: - - Missing (documentation doesn't exist) - - Incorrect (information is wrong) - - Unclear (confusing or hard to follow) - - Outdated (no longer accurate) - - Typo or grammar - validations: - required: true - - - type: input - id: location - attributes: - label: Location - description: Where is this documentation? (URL, file path, or section name) - placeholder: README.adoc, section "Installation" - validations: - required: true - - - type: textarea - id: description - attributes: - label: Description - description: What's the problem with the current documentation? - placeholder: Describe what's wrong or missing - validations: - required: true - - - type: textarea - id: suggestion - attributes: - label: Suggested improvement - description: How should it be fixed or improved? - placeholder: The documentation should say... - validations: - required: false - - - type: checkboxes - id: contribution - attributes: - label: Contribution - options: - - label: I would be willing to submit a PR to fix this - required: false diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/feature_request.md b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/feature_request.md deleted file mode 100644 index 3e8fa7e7e..000000000 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/feature_request.md +++ /dev/null @@ -1,20 +0,0 @@ ---- -name: Feature request -about: Suggest an idea for this project -title: '' -labels: 'enhancement, priority: unset, triage' -assignees: '' - ---- - -**Is your feature request related to a problem? Please describe.** -A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] - -**Describe the solution you'd like** -A clear and concise description of what you want to happen. - -**Describe alternatives you've considered** -A clear and concise description of any alternative solutions or features you've considered. - -**Additional context** -Add any other context or screenshots about the feature request here. diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/question.md b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/question.md deleted file mode 100644 index fd0e2a5cc..000000000 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/ISSUE_TEMPLATE/question.md +++ /dev/null @@ -1,55 +0,0 @@ ---- -name: Question -about: Ask a question about usage or behaviour -title: "[QUESTION]: " -labels: question, triage -assignees: '' - ---- - -name: Question -description: Ask a question about usage or behaviour -title: "[Question]: " -labels: ["question", "triage"] -body: - - type: markdown - attributes: - value: | - Have a question? You can also ask in [Discussions](../discussions) for broader conversations. - - - type: textarea - id: question - attributes: - label: Your question - description: What would you like to know? - placeholder: How do I...? - validations: - required: true - - - type: textarea - id: context - attributes: - label: Context - description: Any relevant context that helps us answer your question - placeholder: I'm trying to achieve X and I've tried Y... - validations: - required: false - - - type: textarea - id: research - attributes: - label: What I've already tried - description: What have you already looked at or attempted? - placeholder: I've read the README and searched issues but... - validations: - required: false - - - type: checkboxes - id: checked - attributes: - label: Pre-submission checklist - options: - - label: I have searched existing issues and discussions - required: true - - label: I have read the documentation - required: true diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/codeql.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/codeql.yml index 90f0622bb..153ea84fb 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/codeql.yml +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/codeql.yml @@ -1,4 +1,5 @@ # SPDX-License-Identifier: MPL-2.0 +# This workflow is managed by gh actions-lock. name: CodeQL Security Analysis on: @@ -7,21 +8,43 @@ on: pull_request: branches: [main, master] schedule: - - cron: '0 6 * * 1' + - cron: '0 6 1 * *' # monthly 1st 06:00 UTC +# Estate guardrail: cancel superseded runs so re-pushes / rebased PR +# updates do not pile up queued runs against the shared account-wide +# Actions concurrency pool. Applied only to read-only check workflows +# (no publish/mutation), so cancelling a superseded run is always safe. concurrency: group: ${{ github.workflow }}-${{ github.ref }} - cancel-in-progress: false + cancel-in-progress: true permissions: + actions: read contents: read jobs: - analyze-js: + analyze: + runs-on: ubuntu-latest permissions: - actions: read contents: read security-events: write - uses: hyperpolymath/standards/.github/workflows/codeql-reusable.yml@210f14e753c80064ec1bcae72f1d654dd9b0e687 - with: - language: javascript-typescript + strategy: + fail-fast: false + matrix: + include: + - language: actions + build-mode: none + steps: + - name: Checkout + uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Initialize CodeQL + uses: github/codeql-action/init@2892aa5e19bbd11bc0cff5427e3b750a04d9e3c2 # v3 + with: + languages: ${{ matrix.language }} + build-mode: ${{ matrix.build-mode }} + + - name: Perform CodeQL Analysis + uses: github/codeql-action/analyze@2892aa5e19bbd11bc0cff5427e3b750a04d9e3c2 # v3 + with: + category: "/language:${{ matrix.language }}" diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/comprehensive-quality.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/comprehensive-quality.yml deleted file mode 100644 index 2ff46e993..000000000 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/comprehensive-quality.yml +++ /dev/null @@ -1,226 +0,0 @@ -# SPDX-License-Identifier: MPL-2.0 -name: Comprehensive Quality Gates - -on: - push: - branches: [main, master] - pull_request: - schedule: - - cron: '0 5 * * *' - -permissions: read-all - -jobs: - # DEPENDABILITY - Stability and reliability - dependability: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check test coverage - run: | - echo "Checking for test files..." - TESTS=$(find . -name "*_test.*" -o -name "test_*" -o -name "*_spec.*" -o -name "*.test.*" | wc -l) - echo "Found $TESTS test files" - if [ "$TESTS" -lt 1 ]; then - echo "::warning::No test files detected" - fi - - name: Check error handling - run: | - # Check for proper error handling patterns - PANICS=$(grep -rE "panic!|unwrap\(\)|expect\(" --include="*.rs" . 2>/dev/null | wc -l || echo "0") - echo "Rust panics/unwraps: $PANICS" - - # SECURITY - Multi-layer security scanning - security: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Secret scanning - uses: trufflesecurity/trufflehog@8a8ef8526528d8a4ff3e2c90be08e25ef8efbd9b # v3.88.3 - continue-on-error: true - - name: Dependency vulnerabilities - run: | - if [ -f "Cargo.toml" ]; then - cargo install cargo-audit && cargo audit || true - fi - if [ -f "requirements.txt" ]; then - pip install safety && safety check -r requirements.txt || true - fi - - name: SAST scan - uses: returntocorp/semgrep-action@v1 - continue-on-error: true - - # INTEROPERABILITY - API and format compatibility - interoperability: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check API specs - run: | - if [ -f "openapi.yaml" ] || [ -f "openapi.json" ]; then - echo "✅ OpenAPI spec found" - fi - if [ -f "schema.graphql" ]; then - echo "✅ GraphQL schema found" - fi - - name: Validate JSON/YAML schemas - run: | - find . -name "*.json" -exec python3 -m json.tool {} \; 2>/dev/null | head -5 || true - - # VALIDATION - Input/output validation - validation: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check for validation patterns - run: | - VALIDATION=$(grep -rE "validate|sanitize|Schema|Validator" --include="*.rs" --include="*.res" --include="*.ex" . 2>/dev/null | wc -l || echo "0") - echo "Validation patterns found: $VALIDATION" - - # ATTESTATION - Supply chain integrity (SLSA) - attestation: - runs-on: ubuntu-latest - timeout-minutes: 30 - permissions: - id-token: write - contents: read - attestations: write - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Generate SBOM - run: | - echo "SBOM generation would run here" - # For Rust: cargo-sbom - # For Node: npm sbom - - name: Check signatures - run: | - if [ -f "CHECKSUMS.txt" ] || [ -f "SHA256SUMS" ]; then - echo "✅ Checksums file present" - fi - - # VERIFICATION - Formal methods where applicable - verification: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check SPARK proofs - run: | - if find . -name "*.ads" | grep -q .; then - echo "Ada/SPARK files found - formal verification applicable" - fi - - name: Type coverage - run: | - if [ -f "rescript.json" ]; then - echo "ReScript provides 100% type coverage" - fi - - # FUNCTIONALITY - Feature completeness - functionality: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check TODOs and FIXMEs - run: | - echo "=== Incomplete items ===" - grep -rn "TODO\|FIXME\|UNIMPLEMENTED\|unimplemented!" . 2>/dev/null | head -20 || echo "None" - - name: Check deprecated usage - run: | - grep -rn "deprecated\|DEPRECATED" . 2>/dev/null | head -10 || echo "No deprecations" - - # PERFORMANCE - Benchmarks and profiling - performance: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check for benchmarks - run: | - BENCHES=$(find . -name "*bench*" -o -name "*perf*" | wc -l) - echo "Benchmark files: $BENCHES" - - name: Binary size check (Rust) - run: | - if [ -f "Cargo.toml" ]; then - cargo build --release 2>/dev/null || true - find target/release -maxdepth 1 -type f -executable -exec ls -lh {} \; 2>/dev/null || true - fi - - # ACCESSIBILITY - A11y compliance - accessibility: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - if: hashFiles('**/*.html') != '' - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: HTML accessibility check - run: | - echo "Checking for a11y attributes..." - A11Y=$(grep -rE 'aria-|role=|alt=' --include="*.html" . 2>/dev/null | wc -l || echo "0") - echo "A11y attributes found: $A11Y" - - name: Lighthouse (if web project) - run: | - echo "Lighthouse would run on deployed URL" - - # LICENSE COMPLIANCE - license: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check license files - run: | - if [ -f "LICENSE" ] || [ -f "LICENSE.txt" ] || [ -f "LICENSE.md" ]; then - echo "✅ License file present" - head -5 LICENSE* 2>/dev/null - else - echo "::warning::No LICENSE file" - fi - - name: Check SPDX headers - run: | - SPDX=$(grep -rE "SPDX-License-Identifier" . 2>/dev/null | wc -l || echo "0") - echo "Files with SPDX headers: $SPDX" - - # DOCUMENTATION QUALITY - documentation: - runs-on: ubuntu-latest - timeout-minutes: 20 - permissions: - contents: read - steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - name: Check docs completeness - run: | - DOCS="" - [ -f "README.md" ] || [ -f "README.adoc" ] && DOCS="$DOCS README" - [ -f "CONTRIBUTING.md" ] || [ -f "3-practice/CONTRIBUTING.adoc" ] && DOCS="$DOCS CONTRIBUTING" - [ -f "CHANGELOG.md" ] && DOCS="$DOCS CHANGELOG" - [ -f "3-practice/SECURITY.md" ] && DOCS="$DOCS SECURITY" - [ -d "docs" ] && DOCS="$DOCS docs/" - echo "Documentation:$DOCS" - - name: Check code comments - run: | - COMMENTS=$(grep -rE "^[[:space:]]*(//|#|/\*)" --include="*.rs" --include="*.res" --include="*.py" . 2>/dev/null | wc -l || echo "0") - echo "Comment lines: $COMMENTS" diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/generator-generic-ossf-slsa3-publish.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/generator-generic-ossf-slsa3-publish.yml index 2ca650b13..9d2b42fff 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/generator-generic-ossf-slsa3-publish.yml +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/generator-generic-ossf-slsa3-publish.yml @@ -1,4 +1,5 @@ # SPDX-License-Identifier: MPL-2.0 +# This workflow is managed by gh actions-lock. # This workflow uses actions that are not certified by GitHub. # They are provided by a third-party and are governed by # separate terms of service, privacy policy, and support @@ -18,19 +19,20 @@ on: release: types: [created] -permissions: read-all +permissions: + actions: read + contents: read jobs: build: runs-on: ubuntu-latest - timeout-minutes: 30 permissions: contents: read outputs: digests: ${{ steps.hash.outputs.digests }} steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 # ======================================================== # @@ -67,7 +69,7 @@ jobs: actions: read # To read the workflow path. id-token: write # To sign the provenance. contents: write # To add assets to a release. - uses: slsa-framework/slsa-github-generator/.github/workflows/generator_generic_slsa3.yml@v2.1.0 + uses: slsa-framework/slsa-github-generator/.github/workflows/generator_generic_slsa3.yml@f7dd8c54c2067bafc12ca7a55595d5ee9b75204a # v2.1.0 with: base64-subjects: "${{ needs.build.outputs.digests }}" upload-assets: true # Optional: Upload to a new release diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/governance.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/governance.yml index ff72fbc89..2b54ed7fa 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/governance.yml +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/governance.yml @@ -1,30 +1,17 @@ # SPDX-License-Identifier: MPL-2.0 -# governance.yml — single wrapper calling the shared estate governance bundle -# in hyperpolymath/standards instead of carrying per-repo copies. -# -# Replaces the per-repo governance scaffolding removed in the same commit: -# quality.yml, guix-nix-policy.yml, npm-bun-blocker.yml, ts-blocker.yml, -# security-policy.yml, rsr-antipattern.yml, wellknown-enforcement.yml, -# workflow-linter.yml -# -# Load-bearing build/security workflows stay standalone in the repo -# (rust-ci, codeql, dependabot, release, scan/mirror/pages plumbing). - +# This workflow is managed by gh actions-lock. name: Governance on: push: branches: [main, master] pull_request: + branches: [main, master] workflow_dispatch: permissions: - actions: read contents: read jobs: governance: - permissions: - actions: read - contents: read - uses: hyperpolymath/standards/.github/workflows/governance-reusable.yml@210f14e753c80064ec1bcae72f1d654dd9b0e687 + uses: hyperpolymath/standards/.github/workflows/governance-reusable.yml@8f2ee50841e216cd8c192eeb68953118190f105c diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/haskell.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/haskell.yml index 5005ae83b..88eeea42e 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/haskell.yml +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/haskell.yml @@ -1,4 +1,5 @@ # SPDX-License-Identifier: MPL-2.0 +# This workflow is managed by gh actions-lock. name: Haskell CI on: @@ -7,24 +8,25 @@ on: pull_request: branches: [ "main" ] -permissions: read-all +permissions: + actions: read + contents: read jobs: build: runs-on: ubuntu-latest - timeout-minutes: 30 permissions: contents: read steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 - - uses: actions/setup-haskell@28c8ff1d6cbeaed15ce310b1952dc19352a0a07d # v1.1.5 + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + - uses: haskell-actions/setup@0f8e8c99d88aeb3fbfd523f1ef2c6f762d10d64d # v2.12.1 with: - ghc-version: '8.10.3' - cabal-version: '3.2' + ghc-version: '9.8.2' + cabal-version: '3.10' - name: Cache - uses: actions/cache@6849a6489940f00c2f30c0fb92c6274307ccb58a # v4.1.2 + uses: actions/cache@55cc8345863c7cc4c66a329aec7e433d2d1c52a9 # v6.1.0 env: cache-name: cache-cabal with: diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/mirror.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/mirror.yml index d5201b962..ca54d84f4 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/mirror.yml +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/mirror.yml @@ -1,4 +1,5 @@ # SPDX-License-Identifier: MPL-2.0 +# This workflow is managed by gh actions-lock. name: Mirror to Git Forges on: @@ -7,12 +8,10 @@ on: workflow_dispatch: permissions: + actions: read contents: read jobs: mirror: - permissions: - actions: read - contents: read - uses: hyperpolymath/standards/.github/workflows/mirror-reusable.yml@210f14e753c80064ec1bcae72f1d654dd9b0e687 + uses: hyperpolymath/standards/.github/workflows/mirror-reusable.yml@8f2ee50841e216cd8c192eeb68953118190f105c secrets: inherit diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/php-security.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/php-security.yml index 541d31721..bc70f2f54 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/php-security.yml +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/php-security.yml @@ -1,18 +1,29 @@ # SPDX-License-Identifier: MPL-2.0 +# This workflow is managed by gh actions-lock. name: PHP Security Check -on: [push, pull_request] +on: + push: + branches: [main, master] + pull_request: -permissions: read-all +# Estate guardrail: scope push to default branches so a PR fires once (not +# push+PR), and cancel superseded runs. Safe — read-only PR-triggered check. +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +permissions: + actions: read + contents: read jobs: security: runs-on: ubuntu-latest - timeout-minutes: 20 permissions: contents: read steps: - - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4.1.1 + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 - name: PHP Security Scan run: | # Check for dangerous functions diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/scorecard.yml b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/scorecard.yml index 0b978aa38..23f4a3ff4 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/scorecard.yml +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.github/workflows/scorecard.yml @@ -1,19 +1,20 @@ # SPDX-License-Identifier: MPL-2.0 +# This workflow is managed by gh actions-lock. name: OSSF Scorecard on: - push: - branches: [main, master] schedule: - - cron: '0 4 * * 0' + - cron: '0 4 * * *' workflow_dispatch: -permissions: read-all - +permissions: + contents: read + security-events: write + id-token: write jobs: - analysis: + scorecard: + uses: hyperpolymath/standards/.github/workflows/scorecard-reusable.yml@8f2ee50841e216cd8c192eeb68953118190f105c permissions: contents: read security-events: write - uses: hyperpolymath/standards/.github/workflows/scorecard-reusable.yml@210f14e753c80064ec1bcae72f1d654dd9b0e687 - secrets: inherit + id-token: write diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.gitignore b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.gitignore index 45f10b185..79fa485f6 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.gitignore +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/.gitignore @@ -54,6 +54,8 @@ __pycache__/ # Haskell /.stack-work/ /dist-newstyle/ +/cabal/ +.cache/ # Chapel *.chpl.tmp.* @@ -77,3 +79,10 @@ htmlcov/ /tmp/ *.tmp *.bak +target/ +node_modules/ +_build/ +deps/ +.elixir_ls/ +build/ +dist/ diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE new file mode 100644 index 000000000..14e2f777f --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE.txt b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE.txt deleted file mode 100644 index 6c758aad9..000000000 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/LICENSE.txt +++ /dev/null @@ -1,91 +0,0 @@ -SPDX-License-Identifier: MPL-2.0 -SPDX-FileCopyrightText: 2024-2025 hyperpolymath - -================================================================================ -DUAL LICENSE: MIT OR PMPL-1.0-or-later -================================================================================ - -This project is dual-licensed under the MIT License OR the GNU Affero General -Public License v3.0 or later. You may choose to use, copy, modify, and -distribute this work under the terms of EITHER license (your choice). - --------------------------------------------------------------------------------- -MIT LICENSE --------------------------------------------------------------------------------- - -Copyright (c) 2024-2025 hyperpolymath - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. - --------------------------------------------------------------------------------- -GNU AFFERO GENERAL PUBLIC LICENSE v3.0 OR LATER --------------------------------------------------------------------------------- - -This program is free software: you can redistribute it and/or modify it under -the terms of the GNU Affero General Public License as published by the Free -Software Foundation, either version 3 of the License, or (at your option) any -later version. - -This program is distributed in the hope that it will be useful, but WITHOUT -ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more -details. - -You should have received a copy of the GNU Affero General Public License along -with this program. If not, see . - -The full text of the AGPL-3.0 is available at: - https://www.gnu.org/licenses/agpl-3.0.txt - --------------------------------------------------------------------------------- -CHOOSING YOUR LICENSE --------------------------------------------------------------------------------- - -You may choose to use this work under: - 1. MIT License - Standard permissive open source license - 2. PMPL-1.0-or-later - Copyleft license requiring source disclosure for - network services - -For most uses, MIT License provides maximum flexibility. -For ensuring open source remains open (especially for SaaS/network services), -PMPL-1.0-or-later provides stronger protections. - -================================================================================ -PALIMPSEST PHILOSOPHICAL OVERLAY (NON-BINDING) -================================================================================ - -This project encourages (but does not legally require) adherence to the -principles of the Palimpsest License - a framework for consent-based digital -interaction and the future web. - -Core Principles (Encouraged): - - Respect for emotional and creative lineage - - Transparent AI training practices with explicit consent - - Preservation of metadata and attribution - - Protection of narrative intent and cultural context - -The Palimpsest principles represent our vision for a consent-based internet. -While not legally binding for use of this software, we encourage all users -and contributors to familiarize themselves with these principles. - -Learn more: https://github.com/hyperpolymath/palimpsest-license - -================================================================================ -END OF LICENSE -================================================================================ diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/README.adoc b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/README.adoc index 8745882ad..c9a00a7ae 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/README.adoc +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/README.adoc @@ -1,4 +1,12 @@ +// SPDX-License-Identifier: MPL-2.0 +// SPDX-License-Identifier: CC-BY-SA-4.0 + = Sanctify-PHP + +image:https://img.shields.io/badge/License-MPL--2.0-blue.svg[License: MPL-2.0,link="https://www.mozilla.org/MPL/2.0/"] +image:https://img.shields.io/badge/Philosophy-Palimpsest-indigo.svg[Palimpsest,link="https://github.com/hyperpolymath/palimpsest-license"] + + :author: Jonathan D.A. Jewell :email: j.d.a.jewell@open.ac.uk :toc: @@ -6,6 +14,14 @@ Haskell-based PHP hardening and security analysis tool. +== Current Status + +Sanctify-PHP already contains substantial parser, analysis, transform, and reporting code, but it should still be treated as a research or beta security tool. + +* The implementation breadth is ahead of the verification depth. +* The most important remaining gaps are taint-analysis tests, end-to-end execution coverage, and proof obligations for the security-analysis core. +* Use link:ROADMAP.adoc[ROADMAP.adoc], link:TEST-NEEDS.md[TEST-NEEDS.md], and link:PROOF-NEEDS.md[PROOF-NEEDS.md] as the primary readiness documents. + == Overview Sanctify-PHP transforms PHP code to be safer and more robust: @@ -18,6 +34,11 @@ Sanctify-PHP transforms PHP code to be safer and more robust: * Generates reports in JSON/SARIF/HTML formats * Exports infrastructure recommendations (php.ini, nginx, Guix) +[NOTE] +==== +This README describes the intended capability surface of the tool. It should not be read as proof that every analysis and transform is already trustworthy enough for production security decisions. +==== + == Installation [source,bash] @@ -30,7 +51,7 @@ cabal install nix build # Using Guix -guix build -f guix.scm +guix build -f build/guix.scm ---- == Usage @@ -147,3 +168,8 @@ PMPL-1.0-or-later * https://github.com/hyperpolymath/aegis[aegis] - Container orchestrator * https://github.com/hyperpolymath/wordpress-wharf[wordpress-wharf] - WordPress deployment * https://github.com/hyperpolymath/wp-audit-toolkit[wp-audit-toolkit] - WordPress auditing + + +== Architecture + +See link:TOPOLOGY.md[TOPOLOGY.md] for a visual architecture map and completion dashboard. diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/app/Main.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/app/Main.hs index 01f9711f9..8da24706d 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/app/Main.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/app/Main.hs @@ -4,43 +4,161 @@ module Main where import System.Environment (getArgs) import System.Exit (exitFailure, exitSuccess) +import System.IO (hFlush, stdout, hPutStrLn, stderr) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as TIO -import System.Directory (doesFileExist, doesDirectoryExist, listDirectory) +import qualified Data.ByteString.Lazy.Char8 as BL8 +import System.Directory (doesFileExist, doesDirectoryExist, listDirectory, getModificationTime) import System.FilePath ((), takeExtension) -import Control.Monad (forM, filterM, when) +import Control.Monad (forM, forM_, filterM, when, unless, forever) +import Control.Concurrent (threadDelay) import Data.Either (partitionEithers) +import Data.List (isPrefixOf, isSuffixOf) +import Data.Maybe (isJust, fromMaybe, catMaybes) +import Data.Time.Clock (UTCTime) +import qualified Data.Map.Strict as Map import Sanctify.Parser import Sanctify.AST import Sanctify.Analysis.Security -import Sanctify.Analysis.Types +import Sanctify.Analysis.Types (emptyTypeContext) import Sanctify.WordPress.Constraints import Sanctify.Transform.StrictTypes import Sanctify.Transform.Sanitize import Sanctify.Transform.TypeHints -import Sanctify.Emit +import Sanctify.Emit (emitPhp, emitPhpIniRecommendations, emitNginxRules, emitGuixOverrides) import Sanctify.Config -import Sanctify.Report +import qualified Sanctify.Report as SReport + +-- | CLI options +data Options = Options + { optCommand :: Command + , optInteractive :: Bool + , optWatch :: Bool + , optFormat :: OutputFormat + , optSeverity :: [Severity] + , optTypes :: [Text] + , optInPlace :: Bool + , optDiff :: Bool + , optVerbose :: Bool + } + +data Command + = Analyze FilePath + | Fix FilePath + | Report FilePath + | ExportPhpIni FilePath + | ExportNginx FilePath + | ExportGuix FilePath + | Help + | Version + +data OutputFormat = FormatText | FormatJSON | FormatSARIF | FormatHTML + deriving (Eq, Show) + +data Severity = Critical | High | Medium | Low | Info + deriving (Eq, Show, Read) main :: IO () main = do args <- getArgs - case args of - ["--help"] -> printHelp - ["-h"] -> printHelp - ["--version"] -> putStrLn "sanctify-php 0.1.0" - ["analyze", path] -> analyzeCommand path - ["fix", path] -> fixCommand path - ["report", path] -> reportCommand path - ["export", "--php-ini", path] -> exportPhpIniCommand path - ["export", "--nginx", path] -> exportNginxCommand path - ["export", "--guix", path] -> exportGuixCommand path - _ -> do - putStrLn "Usage: sanctify [options] " - putStrLn "Run 'sanctify --help' for more information." - exitFailure + opts <- parseArgs args + runCommand opts + +-- | Parse command-line arguments +parseArgs :: [String] -> IO Options +parseArgs args = case args of + [] -> printHelp >> exitFailure + ("--help":_) -> pure $ Options Help False False FormatText [] [] False False False + ("-h":_) -> pure $ Options Help False False FormatText [] [] False False False + ("--version":_) -> pure $ Options Version False False FormatText [] [] False False False + _ -> parseCommand args defaultOptions + where + defaultOptions = Options + { optCommand = Help + , optInteractive = False + , optWatch = False + , optFormat = FormatText + , optSeverity = [] + , optTypes = [] + , optInPlace = False + , optDiff = False + , optVerbose = False + } + +-- | Parse command and options +parseCommand :: [String] -> Options -> IO Options +parseCommand [] opts = pure opts +parseCommand ("analyze":rest) opts = parseOptions rest (opts { optCommand = Analyze "" }) +parseCommand ("fix":rest) opts = parseOptions rest (opts { optCommand = Fix "" }) +parseCommand ("report":rest) opts = parseOptions rest (opts { optCommand = Report "" }) +parseCommand ("export":"--php-ini":rest) opts = parseOptions rest (opts { optCommand = ExportPhpIni "" }) +parseCommand ("export":"--nginx":rest) opts = parseOptions rest (opts { optCommand = ExportNginx "" }) +parseCommand ("export":"--guix":rest) opts = parseOptions rest (opts { optCommand = ExportGuix "" }) +parseCommand (arg:rest) opts + | "--interactive" `isPrefixOf` arg = parseCommand rest (opts { optInteractive = True }) + | "--watch" `isPrefixOf` arg = parseCommand rest (opts { optWatch = True }) + | "--in-place" `isPrefixOf` arg = parseCommand rest (opts { optInPlace = True }) + | "--diff" `isPrefixOf` arg = parseCommand rest (opts { optDiff = True }) + | "-v" == arg || "--verbose" == arg = parseCommand rest (opts { optVerbose = True }) + | "--format=json" `isPrefixOf` arg = parseCommand rest (opts { optFormat = FormatJSON }) + | "--format=sarif" `isPrefixOf` arg = parseCommand rest (opts { optFormat = FormatSARIF }) + | "--format=html" `isPrefixOf` arg = parseCommand rest (opts { optFormat = FormatHTML }) + | "--format=text" `isPrefixOf` arg = parseCommand rest (opts { optFormat = FormatText }) + | "--severity=" `isPrefixOf` arg = + let sevs = parseSeverities (drop 11 arg) + in parseCommand rest (opts { optSeverity = sevs }) + | "--type=" `isPrefixOf` arg = + let types = T.splitOn "," $ T.pack $ drop 7 arg + in parseCommand rest (opts { optTypes = types }) + | not ("-" `isPrefixOf` arg) = pure $ setPath arg opts + | otherwise = do + hPutStrLn stderr $ "Unknown option: " ++ arg + exitFailure + +parseOptions :: [String] -> Options -> IO Options +parseOptions = parseCommand + +setPath :: FilePath -> Options -> Options +setPath path opts = opts { optCommand = updatePath path (optCommand opts) } + where + updatePath p (Analyze _) = Analyze p + updatePath p (Fix _) = Fix p + updatePath p (Report _) = Report p + updatePath p (ExportPhpIni _) = ExportPhpIni p + updatePath p (ExportNginx _) = ExportNginx p + updatePath p (ExportGuix _) = ExportGuix p + updatePath _ cmd = cmd + +parseSeverities :: String -> [Severity] +parseSeverities str = catMaybes $ map readSev $ splitOn ',' str + where + readSev s = case map toLower s of + "critical" -> Just Critical + "high" -> Just High + "medium" -> Just Medium + "low" -> Just Low + "info" -> Just Info + _ -> Nothing + toLower c | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) + | otherwise = c + splitOn _ [] = [] + splitOn delim s = case break (== delim) s of + (a, []) -> [a] + (a, _:b) -> a : splitOn delim b + +-- | Run the command +runCommand :: Options -> IO () +runCommand opts = case optCommand opts of + Help -> printHelp + Version -> putStrLn "sanctify-php 0.2.0-alpha" + Analyze path -> analyzeCommandNew opts path + Fix path -> fixCommandNew opts path + Report path -> reportCommandNew opts path + ExportPhpIni path -> exportPhpIniCommand path + ExportNginx path -> exportNginxCommand path + ExportGuix path -> exportGuixCommand path printHelp :: IO () printHelp = putStrLn $ unlines @@ -61,43 +179,96 @@ printHelp = putStrLn $ unlines , " --guix Generate Guix channel overrides" , "" , "OPTIONS:" - , " -h, --help Show this help" - , " --version Show version" + , " -h, --help Show this help" + , " --version Show version" + , " --interactive Interactive fix mode (prompt for each change)" + , " --watch Watch mode (re-analyze on file changes)" + , " --format= Output format: text, json, sarif, html (default: text)" + , " --severity= Filter by severity: critical,high,medium,low,info" + , " --type= Filter by issue type (comma-separated)" + , " --in-place Apply fixes in-place (modifies files)" + , " --diff Show diff preview of changes" + , " -v, --verbose Verbose output" , "" , "EXAMPLES:" + , " # Basic analysis" , " sanctify analyze ./wp-content/plugins/my-plugin/" - , " sanctify fix --auto-only ./src/" - , " sanctify report --format=sarif ./theme/ > report.sarif" + , "" + , " # Filter high and critical issues only" + , " sanctify analyze --severity=high,critical ./src/" + , "" + , " # Interactive fix with diff preview" + , " sanctify fix --interactive --diff ./theme/" + , "" + , " # Watch mode for development" + , " sanctify analyze --watch ./src/" + , "" + , " # Generate SARIF report for CI/CD" + , " sanctify report --format=sarif ./project/ > report.sarif" + , "" + , " # Export infrastructure configuration" , " sanctify export --php-ini ./project/ >> php.ini" , "" , "For container integration, see:" , " guix/wordpress-container.scm" ] --- | Analyze command -analyzeCommand :: FilePath -> IO () -analyzeCommand path = do +-- | Enhanced analyze command with watch mode and filtering +analyzeCommandNew :: Options -> FilePath -> IO () +analyzeCommandNew opts path + | optWatch opts = watchMode opts path analyzeOnce + | otherwise = analyzeOnce opts path + +analyzeOnce :: Options -> FilePath -> IO () +analyzeOnce opts path = do files <- findPhpFiles path when (null files) $ do putStrLn $ "No PHP files found in: " ++ path exitFailure - putStrLn $ "Analyzing " ++ show (length files) ++ " PHP files..." + when (optVerbose opts) $ + putStrLn $ "Analyzing " ++ show (length files) ++ " PHP files..." results <- forM files $ \file -> do content <- TIO.readFile file case parsePhpString file content of Left err -> do - putStrLn $ " Parse error in " ++ file ++ ": " ++ show err + when (optVerbose opts) $ + putStrLn $ " Parse error in " ++ file ++ ": " ++ show err pure (file, [], []) Right ast -> do - let secIssues = analyzeSecurityIssues ast + let secIssues = filterIssues opts $ analyzeSecurityIssues ast let wpIssues = if isWordPressCode ast then checkWordPressConstraints ast else [] pure (file, secIssues, wpIssues) - -- Print results + -- Output results based on format + case optFormat opts of + FormatText -> outputTextResults opts results + FormatJSON -> outputJSONResults results + FormatSARIF -> outputSARIFResults results + FormatHTML -> outputHTMLResults results + + let totalIssues = sum $ map (\(_, s, w) -> length s + length w) results + if totalIssues > 0 + then exitFailure + else exitSuccess + +-- | Filter issues by severity and type +filterIssues :: Options -> [SecurityIssue] -> [SecurityIssue] +filterIssues opts issues = + let bySeverity = if null (optSeverity opts) + then issues + else filter (\i -> issueSeverity i `elem` optSeverity opts) issues + byType = if null (optTypes opts) + then bySeverity + else filter (\i -> T.pack (show (issueType i)) `elem` optTypes opts) bySeverity + in byType + +-- | Output results as text +outputTextResults :: Options -> [(FilePath, [SecurityIssue], [WordPressIssue])] -> IO () +outputTextResults opts results = do let totalSec = sum $ map (\(_, s, _) -> length s) results let totalWp = sum $ map (\(_, _, w) -> length w) results @@ -111,65 +282,260 @@ analyzeCommand path = do putStrLn $ file ++ ":" forM_ secIssues $ \issue -> putStrLn $ " [" ++ show (issueSeverity issue) ++ "] " ++ T.unpack (issueDescription issue) + ++ " (line " ++ show (posLine $ issueLocation issue) ++ ")" forM_ wpIssues $ \issue -> putStrLn $ " [WP:" ++ show (wpIssueType issue) ++ "] " ++ T.unpack (wpDescription issue) putStrLn "" - if totalSec + totalWp > 0 - then exitFailure - else exitSuccess +-- | Output results as JSON +outputJSONResults :: [(FilePath, [SecurityIssue], [WordPressIssue])] -> IO () +outputJSONResults results = do + putStrLn "{" + putStrLn " \"issues\": [" + let allIssues = concatMap (\(file, sec, wp) -> + map (\i -> " {\"file\": \"" ++ file ++ "\", \"type\": \"security\", \"severity\": \"" ++ show (issueSeverity i) ++ "\", \"message\": \"" ++ T.unpack (issueDescription i) ++ "\", \"line\": " ++ show (posLine $ issueLocation i) ++ "}") sec + ++ map (\i -> " {\"file\": \"" ++ file ++ "\", \"type\": \"wordpress\", \"message\": \"" ++ T.unpack (wpDescription i) ++ "\"}") wp) results + putStrLn $ concat $ insertCommas allIssues + putStrLn " ]" + putStrLn "}" + where + insertCommas [] = [] + insertCommas [x] = [x] + insertCommas (x:xs) = (x ++ ",") : insertCommas xs --- | Fix command -fixCommand :: FilePath -> IO () -fixCommand path = do +-- | Output results as SARIF +outputSARIFResults :: [(FilePath, [SecurityIssue], [WordPressIssue])] -> IO () +outputSARIFResults results = do + putStrLn "{" + putStrLn " \"version\": \"2.1.0\"," + putStrLn " \"$schema\": \"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json\"," + putStrLn " \"runs\": [{" + putStrLn " \"tool\": {" + putStrLn " \"driver\": {" + putStrLn " \"name\": \"sanctify-php\"," + putStrLn " \"version\": \"0.2.0-alpha\"" + putStrLn " }" + putStrLn " }," + putStrLn " \"results\": [" + let sarifResults = concatMap (\(file, sec, _) -> + map (\i -> " {\"ruleId\": \"" ++ show (issueType i) ++ "\", \"level\": \"" ++ severityToLevel (issueSeverity i) ++ "\", \"message\": {\"text\": \"" ++ T.unpack (issueDescription i) ++ "\"}, \"locations\": [{\"physicalLocation\": {\"artifactLocation\": {\"uri\": \"" ++ file ++ "\"}, \"region\": {\"startLine\": " ++ show (posLine $ issueLocation i) ++ "}}}]}") sec) results + putStrLn $ concat $ insertCommas sarifResults + putStrLn " ]" + putStrLn " }]" + putStrLn "}" + where + severityToLevel Critical = "error" + severityToLevel High = "error" + severityToLevel Medium = "warning" + severityToLevel Low = "note" + severityToLevel Info = "note" + insertCommas [] = [] + insertCommas [x] = [x] + insertCommas (x:xs) = (x ++ ",") : insertCommas xs + +-- | Output results as HTML +outputHTMLResults :: [(FilePath, [SecurityIssue], [WordPressIssue])] -> IO () +outputHTMLResults results = do + putStrLn "Sanctify-PHP Report" + putStrLn "" + putStrLn "

Sanctify-PHP Security Report

" + forM_ results $ \(file, secIssues, wpIssues) -> + unless (null secIssues && null wpIssues) $ do + putStrLn $ "

" ++ file ++ "

" + forM_ secIssues $ \issue -> + putStrLn $ "
" + ++ "" ++ show (issueSeverity issue) ++ ": " + ++ T.unpack (issueDescription issue) + ++ " (line " ++ show (posLine $ issueLocation issue) ++ ")
" + putStrLn "" + where + toLower c | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) + | otherwise = c + +-- | Watch mode - re-analyze on file changes +watchMode :: Options -> FilePath -> (Options -> FilePath -> IO ()) -> IO () +watchMode opts path action = do + putStrLn "Watch mode enabled. Press Ctrl+C to exit." + initialMTimes <- getFileMTimes path + action opts path + watchLoop initialMTimes + where + watchLoop lastMTimes = do + threadDelay 1000000 -- 1 second + currentMTimes <- getFileMTimes path + if currentMTimes /= lastMTimes + then do + putStrLn "\n=== Files changed, re-analyzing... ===\n" + action opts path + watchLoop currentMTimes + else watchLoop lastMTimes + + getFileMTimes :: FilePath -> IO (Map.Map FilePath UTCTime) + getFileMTimes dir = do + files <- findPhpFiles dir + mtimes <- forM files $ \f -> do + mtime <- getModificationTime f + pure (f, mtime) + pure $ Map.fromList mtimes + +-- | Old analyze command (kept for compatibility) +analyzeCommand :: FilePath -> IO () +analyzeCommand path = analyzeOnce (Options (Analyze path) False False FormatText [] [] False False False) path + +-- | Enhanced fix command with interactive mode and diff preview +fixCommandNew :: Options -> FilePath -> IO () +fixCommandNew opts path + | optWatch opts = watchMode opts path fixOnce + | otherwise = fixOnce opts path + +fixOnce :: Options -> FilePath -> IO () +fixOnce opts path = do files <- findPhpFiles path - putStrLn $ "Processing " ++ show (length files) ++ " PHP files..." + when (optVerbose opts) $ + putStrLn $ "Processing " ++ show (length files) ++ " PHP files..." - forM_ files $ \file -> do + fixed <- forM files $ \file -> do content <- TIO.readFile file case parsePhpString file content of - Left _ -> putStrLn $ " Skipping (parse error): " ++ file + Left err -> do + when (optVerbose opts) $ + hPutStrLn stderr $ " Parse error in " ++ file ++ ": " ++ show err + pure Nothing Right ast -> do - -- Apply safe transformations let transformed = applyTransforms ast let output = emitPhp transformed - -- Show diff (don't modify in-place by default) - when (content /= output) $ do - putStrLn $ " Would fix: " ++ file - -- In production, write to file or show diff - putStrLn "Done. Use --in-place to apply changes." + if content == output + then pure Nothing + else do + if optInteractive opts + then interactiveFix file content output opts + else autoFix file content output opts + + let fixedCount = length $ filter isJust fixed + putStrLn $ "\nFixed " ++ show fixedCount ++ " file(s)." + unless (optInPlace opts) $ + putStrLn "Use --in-place to apply changes." + +-- | Interactive fix mode +interactiveFix :: FilePath -> Text -> Text -> Options -> IO (Maybe FilePath) +interactiveFix file original modified opts = do + putStrLn $ "\n" ++ file ++ ":" + when (optDiff opts) $ + showDiff original modified + putStr "Apply this fix? [y/N/d(iff)/s(kip all)] " + hFlush stdout + response <- getLine + case map toLower $ take 1 response of + "y" -> do + when (optInPlace opts) $ + TIO.writeFile file modified + putStrLn " ✓ Applied" + pure $ Just file + "d" -> do + showDiff original modified + interactiveFix file original modified opts + "s" -> do + putStrLn " Skipping remaining files..." + exitSuccess + _ -> do + putStrLn " Skipped" + pure Nothing + where + toLower c | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) + | otherwise = c + +-- | Auto fix mode +autoFix :: FilePath -> Text -> Text -> Options -> IO (Maybe FilePath) +autoFix file original modified opts = do + when (optVerbose opts) $ + putStrLn $ " Would fix: " ++ file + when (optDiff opts) $ do + putStrLn $ "\n" ++ file ++ ":" + showDiff original modified + when (optInPlace opts) $ + TIO.writeFile file modified + pure $ Just file + +-- | Show unified diff between two texts +showDiff :: Text -> Text -> IO () +showDiff original modified = do + let origLines = T.lines original + let modLines = T.lines modified + putStrLn "--- original" + putStrLn "+++ modified" + putStrLn $ "@@ -1," ++ show (length origLines) ++ " +1," ++ show (length modLines) ++ " @@" + showDiffLines origLines modLines + where + showDiffLines [] [] = pure () + showDiffLines (o:os) (m:ms) + | o == m = do + putStrLn $ " " ++ T.unpack o + showDiffLines os ms + | otherwise = do + putStrLn $ "-" ++ T.unpack o + putStrLn $ "+" ++ T.unpack m + showDiffLines os ms + showDiffLines (o:os) [] = do + putStrLn $ "-" ++ T.unpack o + showDiffLines os [] + showDiffLines [] (m:ms) = do + putStrLn $ "+" ++ T.unpack m + showDiffLines [] ms + +-- | Old fix command (kept for compatibility) +fixCommand :: FilePath -> IO () +fixCommand path = fixOnce (Options (Fix path) False False FormatText [] [] False False False) path -- | Apply safe transformations applyTransforms :: PhpFile -> PhpFile applyTransforms = addStrictTypes . addAbspathCheck . addTypeHintsFile where - addTypeHintsFile file = addAllTypeHints emptyContext file + addTypeHintsFile file = addAllTypeHints emptyTypeContext file --- | Report command -reportCommand :: FilePath -> IO () -reportCommand path = do +-- | Enhanced report command with multiple output formats +reportCommandNew :: Options -> FilePath -> IO () +reportCommandNew opts path = do files <- findPhpFiles path + + when (optVerbose opts) $ + putStrLn $ "Generating report for " ++ show (length files) ++ " PHP files..." + fileReports <- forM files $ \file -> do content <- TIO.readFile file case parsePhpString file content of - Left _ -> pure $ generateFileReport file [] [] 0 0 False + Left _ -> pure $ SReport.generateFileReport file [] [] 0 0 False Right ast -> do - let secIssues = analyzeSecurityIssues ast + let secIssues = filterIssues opts $ analyzeSecurityIssues ast let wpIssues = if isWordPressCode ast then checkWordPressConstraints ast else [] let autoFixed = length $ filter (canAutoFix . issueType) secIssues let manual = length secIssues - autoFixed - pure $ generateFileReport file secIssues wpIssues autoFixed manual False + pure $ SReport.generateFileReport file secIssues wpIssues autoFixed manual False - report <- generateReport defaultConfig fileReports - TIO.putStrLn $ renderText report + case optFormat opts of + FormatText -> do + report <- SReport.generateReport defaultConfig fileReports + TIO.putStrLn $ SReport.renderText report + FormatJSON -> do + report <- SReport.generateReport defaultConfig fileReports + BL8.putStrLn $ SReport.renderJson report + FormatSARIF -> do + report <- SReport.generateReport defaultConfig fileReports + BL8.putStrLn $ SReport.renderSarif report + FormatHTML -> do + report <- SReport.generateReport defaultConfig fileReports + TIO.putStrLn $ SReport.renderHtml report where canAutoFix :: IssueType -> Bool canAutoFix MissingStrictTypes = True canAutoFix _ = False +-- | Old report command (kept for compatibility) +reportCommand :: FilePath -> IO () +reportCommand path = reportCommandNew (Options (Report path) False False FormatText [] [] False False False) path + -- | Export php.ini recommendations exportPhpIniCommand :: FilePath -> IO () exportPhpIniCommand path = do diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/bench/Main.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/bench/Main.hs new file mode 100644 index 000000000..973a0ff8e --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/bench/Main.hs @@ -0,0 +1,174 @@ +-- | Benchmark suite for sanctify-php +-- SPDX-License-Identifier: MPL-2.0 +module Main where + +import Criterion.Main +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.FilePath (()) + +import Sanctify.Parser +import Sanctify.Analysis.Security +import Sanctify.Analysis.Advanced +import Sanctify.Transform.Sanitize +import Sanctify.Transform.Strict +import Sanctify.Emit + +main :: IO () +main = do + -- Read fixture files for benchmarking + sqlCode <- TIO.readFile ("test" "fixtures" "vulnerable-sql.php") + xssCode <- TIO.readFile ("test" "fixtures" "vulnerable-xss.php") + wpCode <- TIO.readFile ("test" "fixtures" "wordpress-unsafe.php") + + -- Generate synthetic PHP for throughput testing + let smallPhp = generatePhp 10 + let mediumPhp = generatePhp 100 + let largePhp = generatePhp 500 + + defaultMain + [ bgroup "Parser" + [ bench "small PHP (10 lines)" $ nf parseSmall smallPhp + , bench "medium PHP (100 lines)" $ nf parseMedium mediumPhp + , bench "large PHP (500 lines)" $ nf parseLarge largePhp + , bench "sql-injection fixture" $ nf parseFixture sqlCode + , bench "xss fixture" $ nf parseFixture xssCode + , bench "wordpress fixture" $ nf parseFixture wpCode + ] + + , bgroup "Security Analysis" + [ bench "small PHP analysis" $ nf analyzeSmall smallPhp + , bench "medium PHP analysis" $ nf analyzeMedium mediumPhp + , bench "large PHP analysis" $ nf analyzeLarge largePhp + , bench "sql-injection analysis" $ nf analyzeFixture sqlCode + , bench "xss analysis" $ nf analyzeFixture xssCode + ] + + , bgroup "Transformation" + [ bench "strict transform (small)" $ nf transformSmallStrict smallPhp + , bench "strict transform (medium)" $ nf transformMediumStrict mediumPhp + , bench "sanitize transform (small)" $ nf transformSmallSanitize smallPhp + , bench "sanitize transform (medium)" $ nf transformMediumSanitize mediumPhp + ] + + , bgroup "Emission (Code Generation)" + [ bench "emit small PHP" $ nf emitSmall smallPhp + , bench "emit medium PHP" $ nf emitMedium mediumPhp + , bench "emit large PHP" $ nf emitLarge largePhp + ] + + , bgroup "Full Pipeline" + [ bench "parse + analyze + emit (small)" $ nf fullPipelineSmall smallPhp + , bench "parse + analyze + emit (medium)" $ nf fullPipelineMedium mediumPhp + , bench "parse + analyze + emit (large)" $ nf fullPipelineLarge largePhp + ] + ] + +-- Helpers for small benchmarks +parseSmall :: T.Text -> Either String () +parseSmall code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right _ -> Right () + +parseMedium :: T.Text -> Either String () +parseMedium code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right _ -> Right () + +parseLarge :: T.Text -> Either String () +parseLarge code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right _ -> Right () + +parseFixture :: T.Text -> Either String () +parseFixture code = case parsePhpString "fixture.php" code of + Left _ -> Left "parse error" + Right _ -> Right () + +analyzeSmall :: T.Text -> Either String Int +analyzeSmall code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (length (analyzeSecurityIssues ast)) + +analyzeMedium :: T.Text -> Either String Int +analyzeMedium code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (length (analyzeSecurityIssues ast)) + +analyzeLarge :: T.Text -> Either String Int +analyzeLarge code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (length (analyzeSecurityIssues ast)) + +analyzeFixture :: T.Text -> Either String Int +analyzeFixture code = case parsePhpString "fixture.php" code of + Left _ -> Left "parse error" + Right ast -> Right (length (analyzeSecurityIssues ast)) + +transformSmallStrict :: T.Text -> Either String () +transformSmallStrict code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (let _ = transformStrict ast in ()) + +transformMediumStrict :: T.Text -> Either String () +transformMediumStrict code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (let _ = transformStrict ast in ()) + +transformSmallSanitize :: T.Text -> Either String () +transformSmallSanitize code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (let _ = transformSanitizeOutput ast in ()) + +transformMediumSanitize :: T.Text -> Either String () +transformMediumSanitize code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (let _ = transformSanitizeOutput ast in ()) + +emitSmall :: T.Text -> Either String () +emitSmall code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (let _ = emitPhp ast in ()) + +emitMedium :: T.Text -> Either String () +emitMedium code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (let _ = emitPhp ast in ()) + +emitLarge :: T.Text -> Either String () +emitLarge code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> Right (let _ = emitPhp ast in ()) + +fullPipelineSmall :: T.Text -> Either String T.Text +fullPipelineSmall code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> + let transformed = transformSanitizeOutput (transformStrict ast) + emitted = emitPhp transformed + in Right emitted + +fullPipelineMedium :: T.Text -> Either String T.Text +fullPipelineMedium code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> + let transformed = transformSanitizeOutput (transformStrict ast) + emitted = emitPhp transformed + in Right emitted + +fullPipelineLarge :: T.Text -> Either String T.Text +fullPipelineLarge code = case parsePhpString "test.php" code of + Left _ -> Left "parse error" + Right ast -> + let transformed = transformSanitizeOutput (transformStrict ast) + emitted = emitPhp transformed + in Right emitted + +-- Generate synthetic PHP code for benchmarking +generatePhp :: Int -> T.Text +generatePhp lineCount = + T.pack $ unlines $ + [ "=4.17, + base >=4.17, text >=2.0, containers >=0.6, mtl >=2.3, @@ -59,7 +65,8 @@ library vector >=0.13, unordered-containers >=0.2, prettyprinter >=1.7, - optparse-applicative >=0.18 + optparse-applicative >=0.18, + time >=1.12 hs-source-dirs: src default-language: GHC2021 default-extensions: @@ -73,26 +80,69 @@ executable sanctify import: warnings main-is: Main.hs build-depends: - base ^>=4.17, + base >=4.17, sanctify-php, text, + containers, + mtl, optparse-applicative, filepath, - directory + directory, + time, + aeson, + bytestring hs-source-dirs: app default-language: GHC2021 default-extensions: OverloadedStrings + LambdaCase test-suite sanctify-php-test import: warnings default-language: GHC2021 + default-extensions: + OverloadedStrings type: exitcode-stdio-1.0 hs-source-dirs: test - main-is: Main.hs + main-is: Spec.hs + other-modules: + ParserSpec + SecuritySpec + TransformSpec + E2ESpec + PropertySpec + AspectSpec build-depends: - base ^>=4.17, + base >=4.17, sanctify-php, hspec >=2.10, + hspec-discover >=2.10, hspec-megaparsec >=2.2, - text + hspec-golden >=0.2, + QuickCheck >=2.14, + text, + containers, + filepath, + directory, + bytestring, + transformers + build-tool-depends: + hspec-discover:hspec-discover >=2.10 + +benchmark sanctify-php-bench + default-language: GHC2021 + default-extensions: + OverloadedStrings + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Main.hs + build-depends: + base >=4.17, + sanctify-php, + criterion >=1.6, + text, + filepath + ghc-options: + -O2 + -rtsopts + -with-rtsopts=-N diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/AST.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/AST.hs index 48dec98ae..56cb9a3b2 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/AST.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/AST.hs @@ -4,13 +4,16 @@ module Sanctify.AST ( -- * Top-level structures PhpFile(..) + , UseDecl(..) + , UseKind(..) , Statement(..) , Declaration(..) , Visibility(..) , Modifier(..) - -- * Expressions + -- * Expressions , Expr(..) + , IncludeType(..) , Literal(..) , BinOp(..) , UnaryOp(..) @@ -30,9 +33,17 @@ module Sanctify.AST , ReturnType(..) -- * Control flow + , SwitchCase(..) , MatchArm(..) , CatchClause(..) + -- * Class members + , ClassMember(..) + , InterfaceMethod(..) + , EnumCase(..) + , TraitAdaptation(..) + , Attribute(..) + -- * Source location , SourcePos(..) , Located(..) @@ -88,12 +99,12 @@ data UseKind = UseClass | UseFunction | UseConstant -- | Variable reference newtype Variable = Variable { varName :: Text } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving anyclass (ToJSON, FromJSON) -- | Simple name/identifier newtype Name = Name { unName :: Text } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving anyclass (ToJSON, FromJSON) -- | Qualified name (namespaced) diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Advanced.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Advanced.hs new file mode 100644 index 000000000..b8c2fa36f --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Advanced.hs @@ -0,0 +1,448 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Advanced Security Analysis - Beyond OWASP Top 10 +-- SPDX-License-Identifier: MPL-2.0 +module Sanctify.Analysis.Advanced + ( -- * Advanced vulnerability detection + checkReDoS + , checkSSRF + , checkXXE + , checkTOCTOU + , checkMassAssignment + , checkPrototypePollution + , checkOpenRedirect + + -- * WordPress-specific advanced checks + , checkPrivilegeEscalation + , checkObjectInjection + , checkFileInclusionChain + + -- * Timing attacks + , checkTimingAttacks + , checkConstantTimeComparison + + -- * Data exposure + , checkSensitiveDataExposure + , checkInformationDisclosure + + -- * Types + , AdvancedIssue(..) + , AdvancedIssueType(..) + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Set (Set) +import qualified Data.Set as Set +import Control.Monad (when) +import Control.Monad.Writer +import GHC.Generics (Generic) +import Data.Aeson (ToJSON) + +import Sanctify.AST +import Sanctify.Analysis.Security (SecurityIssue(..), Severity(..)) + +-- | Types of advanced security issues +data AdvancedIssueType + = ReDoS -- ^ Regular expression denial of service + | SSRF -- ^ Server-side request forgery + | XXE -- ^ XML external entity injection + | TOCTOU -- ^ Time-of-check-time-of-use + | MassAssignment -- ^ Mass assignment vulnerability + | ObjectInjection -- ^ PHP object injection + | PrototypePollution -- ^ Prototype pollution (array key overwrite) + | OpenRedirect -- ^ Open redirect vulnerability + | PrivilegeEscalation -- ^ Privilege escalation + | TimingAttack -- ^ Timing attack vulnerability + | SensitiveDataExposure -- ^ Sensitive data in logs/errors + | InformationDisclosure -- ^ Information disclosure + | FileInclusionChain -- ^ Chained file inclusion vulnerability + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON) + +-- | Advanced security issue +data AdvancedIssue = AdvancedIssue + { advType :: AdvancedIssueType + , advSeverity :: Severity + , advLocation :: SourcePos + , advDescription :: Text + , advRemedy :: Text + , advCode :: Maybe Text + , advCWE :: Maybe Int -- CWE identifier + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON) + +type AdvancedM = Writer [AdvancedIssue] + +-- | Check for Regular Expression Denial of Service (ReDoS) +-- Detects catastrophic backtracking patterns in regexes +checkReDoS :: Located Expr -> [AdvancedIssue] +checkReDoS (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["preg_match", "preg_match_all", "preg_replace", "preg_split"] + , not (null args) -> + let pattern = argValue $ head args + in case extractStringLiteral pattern of + Just regex | hasDangerousPattern regex -> + [AdvancedIssue ReDoS High pos + "Regular expression may cause catastrophic backtracking (ReDoS)" + "Avoid nested quantifiers, alternation with overlap, or use atomic groups" + (Just regex) + (Just 1333)] -- CWE-1333: Inefficient Regular Expression Complexity + _ -> [] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + where + -- Detect dangerous regex patterns + hasDangerousPattern :: Text -> Bool + hasDangerousPattern regex = + -- Nested quantifiers: (a+)+ or (a*)* or (a+)* + ("(.*)*" `T.isInfixOf` regex) || + ("(.+)+" `T.isInfixOf` regex) || + ("(.*++" `T.isInfixOf` regex) || + -- Alternation with overlap: (a|a)* + ("(a|a)" `T.isInfixOf` regex) || + -- Many quantifiers in succession + (T.length (T.filter (`elem` ['*', '+', '?']) regex) > 5) + +-- | Check for Server-Side Request Forgery (SSRF) +checkSSRF :: Located Expr -> [AdvancedIssue] +checkSSRF (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ssrfFunctions + , any (containsUserInput . argValue) args -> + [AdvancedIssue SSRF High pos + ("SSRF vulnerability in " <> fname <> ": user controls URL") + "Validate URLs against whitelist, use URL parsing to check scheme/host" + (Just fname) + (Just 918)] -- CWE-918: Server-Side Request Forgery + where fname = T.toLower $ unName $ last $ qnParts qn + + ExprMethodCall obj (Name method) args + | T.toLower method `elem` ["get", "post", "request", "fetch"] + , containsUserInput obj || any (containsUserInput . argValue) args -> + [AdvancedIssue SSRF High pos + "SSRF via HTTP client: user controls request URL" + "Validate URL scheme (http/https only), check against whitelist" + (Just method) + (Just 918)] + _ -> [] + where + ssrfFunctions = ["file_get_contents", "fopen", "curl_exec", "curl_init", + "wp_remote_get", "wp_remote_post", "wp_remote_request"] + + containsUserInput :: Located Expr -> Bool + containsUserInput (Located _ e) = case e of + ExprVariable (Variable name) -> + name `elem` ["_GET", "_POST", "_REQUEST", "_COOKIE", "_SERVER"] + ExprArrayAccess base _ -> containsUserInput base + ExprBinary OpConcat left right -> containsUserInput left || containsUserInput right + _ -> False + +-- | Check for XML External Entity (XXE) injection +checkXXE :: Located Expr -> [AdvancedIssue] +checkXXE (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | let fname = T.toLower $ unName $ last $ qnParts qn + , fname `elem` ["simplexml_load_string", "simplexml_load_file", "SimpleXMLElement"] + , not (hasLibxmlDisableEntityLoader args) + , any (exprContainsUserInput . argValue) args -> + [AdvancedIssue XXE Critical pos + ("XXE vulnerability: " <> fname <> " without entity loader disabled") + "Call libxml_disable_entity_loader(true) before parsing XML" + (Just fname) + (Just 611)] -- CWE-611: Improper Restriction of XML External Entity Reference + + ExprNew qn args + | className `elem` ["DOMDocument", "SimpleXMLElement"] + , not (hasLibxmlDisableEntityLoader args) -> + [AdvancedIssue XXE Critical pos + ("XXE vulnerability: " <> className <> " without protection") + "Disable entity loading and set LIBXML_NOENT | LIBXML_DTDLOAD options" + (Just className) + (Just 611)] + where className = T.pack $ show qn + _ -> [] + where + hasLibxmlDisableEntityLoader :: [Argument] -> Bool + hasLibxmlDisableEntityLoader _args = False -- TODO: check for LIBXML_NOENT option + + exprContainsUserInput :: Located Expr -> Bool + exprContainsUserInput (Located _ e) = case e of + ExprVariable (Variable name) -> + name `elem` ["_GET", "_POST", "_REQUEST", "_COOKIE", "_SERVER"] + ExprArrayAccess base _ -> exprContainsUserInput base + ExprBinary OpConcat left right -> exprContainsUserInput left || exprContainsUserInput right + _ -> False + +-- | Check for Time-of-Check-Time-of-Use (TOCTOU) race conditions +checkTOCTOU :: [Located Statement] -> [AdvancedIssue] +checkTOCTOU stmts = execWriter $ checkStatements stmts + where + checkStatements :: [Located Statement] -> AdvancedM () + checkStatements ss = mapM_ checkPair (zip ss (drop 1 ss)) + + checkPair :: (Located Statement, Located Statement) -> AdvancedM () + checkPair (Located pos1 stmt1, Located pos2 stmt2) = do + -- Check for file_exists() followed by file operation + when (isFileCheck stmt1 && isFileOp stmt2) $ + tell [AdvancedIssue TOCTOU Medium pos1 + "TOCTOU race condition: file checked then operated on" + "Use atomic operations or file locking (flock)" + Nothing + (Just 367)] -- CWE-367: Time-of-Check Time-of-Use Race Condition + + -- Check for is_writable/is_readable followed by file write/read + when (isPermissionCheck stmt1 && isFileOp stmt2) $ + tell [AdvancedIssue TOCTOU Medium pos1 + "TOCTOU: permission check followed by file operation" + "Check permissions after opening file or use exception handling" + Nothing + (Just 367)] + + isFileCheck :: Statement -> Bool + isFileCheck (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in fn `elem` ["file_exists", "is_file", "is_dir"] + isFileCheck _ = False + + isPermissionCheck :: Statement -> Bool + isPermissionCheck (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in fn `elem` ["is_writable", "is_writeable", "is_readable"] + isPermissionCheck _ = False + + isFileOp :: Statement -> Bool + isFileOp (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in fn `elem` ["fopen", "file_get_contents", "file_put_contents", + "unlink", "rename", "copy", "move_uploaded_file"] + isFileOp _ = False + +-- | Check for mass assignment vulnerabilities +checkMassAssignment :: Located Expr -> [AdvancedIssue] +checkMassAssignment (Located pos expr) = case expr of + -- Direct $_POST assignment to object properties + ExprAssign (Located _ (ExprPropertyAccess _ _)) (Located _ (ExprVariable (Variable "_POST"))) -> + [AdvancedIssue MassAssignment High pos + "Mass assignment: entire $_POST assigned to object" + "Explicitly assign only allowed fields after validation" + Nothing + (Just 915)] -- CWE-915: Improperly Controlled Modification of Dynamically-Determined Object Attributes + + -- Array merge with $_POST + ExprCall (Located _ (ExprConstant qn)) args + | fname == "array_merge" + , any isPostVariable args -> + [AdvancedIssue MassAssignment Medium pos + "Mass assignment via array_merge with $_POST" + "Filter $_POST array to only allowed keys before merging" + (Just "array_merge") + (Just 915)] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + where + isPostVariable :: Argument -> Bool + isPostVariable arg = case locNode (argValue arg) of + ExprVariable (Variable "_POST") -> True + ExprVariable (Variable "_REQUEST") -> True + _ -> False + +-- | Check for PHP object injection via unserialize +checkObjectInjection :: Located Expr -> [AdvancedIssue] +checkObjectInjection (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname == "unserialize" + , not (hasAllowedClassesOption args) -> + let severity = if any containsUserInput args then Critical else High + in [AdvancedIssue ObjectInjection severity pos + "PHP object injection: unserialize without allowed_classes restriction" + "Specify 'allowed_classes' => [] or use json_decode instead" + (Just "unserialize") + (Just 502)] -- CWE-502: Deserialization of Untrusted Data + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + where + hasAllowedClassesOption :: [Argument] -> Bool + hasAllowedClassesOption args = length args >= 2 -- Simplified check + + containsUserInput :: Argument -> Bool + containsUserInput arg = case locNode (argValue arg) of + ExprVariable (Variable v) -> v `elem` ["_GET", "_POST", "_COOKIE", "_REQUEST"] + ExprArrayAccess base _ -> containsUserInput (Argument Nothing base False) + _ -> False + +-- | Check for open redirect vulnerabilities +checkOpenRedirect :: Located Expr -> [AdvancedIssue] +checkOpenRedirect (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["header", "wp_redirect", "wp_safe_redirect"] + , any hasLocationHeader args -> + [AdvancedIssue OpenRedirect Medium pos + "Open redirect: user controls redirect URL" + "Validate redirect URL against whitelist or use wp_safe_redirect()" + (Just fname) + (Just 601)] -- CWE-601: URL Redirection to Untrusted Site + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + where + hasLocationHeader :: Argument -> Bool + hasLocationHeader arg = case locNode (argValue arg) of + ExprBinary OpConcat (Located _ (ExprLiteral (LitString s))) right + | "Location:" `T.isPrefixOf` s -> containsUserInput right + _ -> False + + containsUserInput :: Located Expr -> Bool + containsUserInput (Located _ e) = case e of + ExprVariable (Variable v) -> v `elem` ["_GET", "_POST", "_REQUEST"] + ExprArrayAccess base _ -> containsUserInput base + _ -> False + +-- | Check for WordPress privilege escalation +checkPrivilegeEscalation :: PhpFile -> [AdvancedIssue] +checkPrivilegeEscalation file = execWriter $ mapM_ checkStmt (phpStatements file) + where + checkStmt :: Located Statement -> AdvancedM () + checkStmt (Located pos stmt) = case stmt of + StmtExpr expr -> checkExpr pos expr + StmtDecl (DeclFunction{fnBody = body}) -> mapM_ checkStmt body + _ -> pure () + + checkExpr :: SourcePos -> Located Expr -> AdvancedM () + checkExpr pos (Located _ expr) = case expr of + -- wp_set_current_user without capability check + ExprCall (Located _ (ExprConstant qn)) _ + | fname == "wp_set_current_user" + , not (hasCapabilityCheck file) -> + tell [AdvancedIssue PrivilegeEscalation Critical pos + "Privilege escalation: wp_set_current_user without capability check" + "Add current_user_can() check before changing user context" + (Just "wp_set_current_user") + (Just 269)] -- CWE-269: Improper Privilege Management + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> pure () + + hasCapabilityCheck :: PhpFile -> Bool + hasCapabilityCheck f = any (hasCapCheck . locNode) (phpStatements f) + + hasCapCheck :: Statement -> Bool + hasCapCheck (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in fn `elem` ["current_user_can", "user_can", "is_admin", "is_super_admin"] + hasCapCheck _ = False + +-- | Check for timing attack vulnerabilities in comparisons +checkTimingAttacks :: Located Expr -> [AdvancedIssue] +checkTimingAttacks (Located pos expr) = case expr of + -- Direct string comparison of sensitive values + ExprBinary op left right + | op `elem` [OpEq, OpIdentical, OpNeq, OpNotIdentical] + , isSensitiveComparison left right -> + [AdvancedIssue TimingAttack Medium pos + "Timing attack: non-constant-time comparison of sensitive data" + "Use hash_equals() for cryptographic comparisons" + Nothing + (Just 208)] -- CWE-208: Observable Timing Discrepancy + _ -> [] + where + isSensitiveComparison :: Located Expr -> Located Expr -> Bool + isSensitiveComparison l r = + isSensitive l || isSensitive r + + isSensitive :: Located Expr -> Bool + isSensitive (Located _ e) = case e of + ExprVariable (Variable v) -> + any (`T.isInfixOf` T.toLower v) ["password", "token", "secret", "key", "hash"] + ExprArrayAccess base _ -> isSensitive base + _ -> False + +-- | Check for constant-time comparison usage +checkConstantTimeComparison :: Located Expr -> Maybe AdvancedIssue +checkConstantTimeComparison (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) _ + | fname == "hash_equals" -> Nothing -- Good! Using constant-time comparison + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> Just $ AdvancedIssue TimingAttack Info pos + "Consider using hash_equals() for cryptographic comparisons" + "Replace string comparison with hash_equals() for secrets/tokens" + Nothing + (Just 208) + +-- | Check for sensitive data exposure in logs/errors +checkSensitiveDataExposure :: Located Expr -> [AdvancedIssue] +checkSensitiveDataExposure (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["error_log", "trigger_error", "var_dump", "print_r", "var_export"] + , any hasSensitiveData args -> + [AdvancedIssue SensitiveDataExposure High pos + ("Sensitive data in " <> fname <> ": may expose secrets in logs") + "Redact sensitive data before logging" + (Just fname) + (Just 532)] -- CWE-532: Insertion of Sensitive Information into Log File + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + where + hasSensitiveData :: Argument -> Bool + hasSensitiveData arg = case locNode (argValue arg) of + ExprVariable (Variable v) -> + any (`T.isInfixOf` T.toLower v) ["password", "token", "secret", "key", "credit_card"] + _ -> False + +-- | Check for information disclosure +checkInformationDisclosure :: PhpFile -> [AdvancedIssue] +checkInformationDisclosure file = execWriter $ mapM_ checkStmt (phpStatements file) + where + checkStmt :: Located Statement -> AdvancedM () + checkStmt (Located pos stmt) = case stmt of + -- phpinfo() call + StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _)) + | fname == "phpinfo" -> + tell [AdvancedIssue InformationDisclosure High pos + "Information disclosure: phpinfo() exposes server configuration" + "Remove phpinfo() from production code" + (Just "phpinfo()") + (Just 200)] -- CWE-200: Exposure of Sensitive Information + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> pure () + +-- | Check for chained file inclusion vulnerabilities +checkFileInclusionChain :: [Located Statement] -> [AdvancedIssue] +checkFileInclusionChain stmts = execWriter $ checkForChain stmts + where + checkForChain :: [Located Statement] -> AdvancedM () + checkForChain ss = do + let includes = filter isIncludeStmt ss + when (length includes > 3) $ + tell [AdvancedIssue FileInclusionChain Medium (locPos $ head includes) + "Multiple file inclusions may create attack chain" + "Limit dynamic inclusions and validate paths" + Nothing + (Just 829)] -- CWE-829: Inclusion of Functionality from Untrusted Control Sphere + + isIncludeStmt :: Located Statement -> Bool + isIncludeStmt (Located _ (StmtExpr (Located _ (ExprInclude _ _)))) = True + isIncludeStmt _ = False + +-- | Check for prototype pollution (array key manipulation) +checkPrototypePollution :: Located Expr -> [AdvancedIssue] +checkPrototypePollution (Located pos expr) = case expr of + -- User-controlled array keys + ExprArrayAccess base (Just key) + | containsUserInput base || containsUserInput key -> + [AdvancedIssue PrototypePollution Medium pos + "Array key manipulation: user controls array index" + "Validate array keys against whitelist before use" + Nothing + (Just 1321)] -- CWE-1321: Improperly Controlled Modification of Object Prototype Attributes + _ -> [] + where + containsUserInput :: Located Expr -> Bool + containsUserInput (Located _ e) = case e of + ExprVariable (Variable v) -> v `elem` ["_GET", "_POST", "_REQUEST"] + ExprArrayAccess b _ -> containsUserInput b + _ -> False + +-- Helper: Extract string literal from expression +extractStringLiteral :: Located Expr -> Maybe Text +extractStringLiteral (Located _ (ExprLiteral (LitString s))) = Just s +extractStringLiteral _ = Nothing diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/DeadCode.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/DeadCode.hs new file mode 100644 index 000000000..0a01cd4a5 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/DeadCode.hs @@ -0,0 +1,366 @@ +-- | Dead code analysis for PHP +-- Detects unused variables and unreachable code +-- SPDX-License-Identifier: MPL-2.0 +module Sanctify.Analysis.DeadCode + ( -- * Main analysis + analyzeDeadCode + , DeadCodeIssue(..) + , DeadCodeType(..) + + -- * Specific checks + , findUnusedVariables + , findUnreachableCode + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Data.List (foldl') +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Control.Monad (forM_, mapM_, unless, when) +import Control.Monad.State.Strict +import GHC.Generics (Generic) +import Data.Aeson (ToJSON) + +import Sanctify.AST + +-- | Types of dead code issues +data DeadCodeType + = UnusedVariable -- ^ Variable declared but never used + | UnreachableCode -- ^ Code after return/throw/exit + | UnusedParameter -- ^ Function parameter never used + | UnusedImport -- ^ Use statement never referenced + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON) + +-- | A detected dead code issue +data DeadCodeIssue = DeadCodeIssue + { dcType :: DeadCodeType + , dcLocation :: SourcePos + , dcDescription :: Text + , dcIdentifier :: Text -- The name of the unused variable/etc. + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON) + +-- | Analysis state for tracking variable usage +data AnalysisState = AnalysisState + { asDeclared :: Map Text SourcePos -- ^ Variables that have been declared/assigned + , asUsed :: Set Text -- ^ Variables that have been read + , asIssues :: [DeadCodeIssue] -- ^ Accumulated issues + } + deriving stock (Eq, Show) + +type AnalysisM = State AnalysisState + +-- | Initial analysis state +initialState :: AnalysisState +initialState = AnalysisState Map.empty Set.empty [] + +-- | Analyze a PHP file for dead code issues +analyzeDeadCode :: PhpFile -> [DeadCodeIssue] +analyzeDeadCode file = + let finalState = execState (analyzeStatements (phpStatements file)) initialState + unusedVars = findUnusedFromState finalState + in unusedVars ++ asIssues finalState + +-- | Find unused variables from the final state +findUnusedFromState :: AnalysisState -> [DeadCodeIssue] +findUnusedFromState state = + let declared = asDeclared state + used = asUsed state + unused = Map.filterWithKey (\k _ -> not (Set.member k used)) declared + in map mkUnusedIssue (Map.toList unused) + where + mkUnusedIssue (name, pos) = DeadCodeIssue + { dcType = UnusedVariable + , dcLocation = pos + , dcDescription = "Variable '$" <> name <> "' is assigned but never used" + , dcIdentifier = name + } + +-- | Analyze a list of statements, detecting unreachable code +analyzeStatements :: [Located Statement] -> AnalysisM () +analyzeStatements [] = pure () +analyzeStatements (stmt:rest) = do + analyzeStatement stmt + -- Check if current statement is a terminator + when (isTerminator (locNode stmt)) $ do + -- Mark remaining statements as unreachable + forM_ rest $ \(Located pos s) -> + unless (isNoop s) $ + addIssue DeadCodeIssue + { dcType = UnreachableCode + , dcLocation = pos + , dcDescription = "Unreachable code after " <> terminatorName (locNode stmt) + , dcIdentifier = "" + } + -- Continue analyzing rest only if not a terminator + unless (isTerminator (locNode stmt)) $ + analyzeStatements rest + +-- | Check if a statement is a control flow terminator +isTerminator :: Statement -> Bool +isTerminator = \case + StmtReturn _ -> True + StmtThrow _ -> True + StmtBreak _ -> True + StmtContinue _ -> True + _ -> False + +-- | Get the name of the terminator for error messages +terminatorName :: Statement -> Text +terminatorName = \case + StmtReturn _ -> "return statement" + StmtThrow _ -> "throw statement" + StmtBreak _ -> "break statement" + StmtContinue _ -> "continue statement" + _ -> "terminating statement" + +-- | Check if a statement is a no-op (empty statement) +isNoop :: Statement -> Bool +isNoop StmtNoop = True +isNoop _ = False + +-- | Add an issue to the state +addIssue :: DeadCodeIssue -> AnalysisM () +addIssue issue = modify' $ \s -> s { asIssues = issue : asIssues s } + +-- | Record that a variable was declared/assigned +declareVar :: Text -> SourcePos -> AnalysisM () +declareVar name pos = modify' $ \s -> + s { asDeclared = Map.insert name pos (asDeclared s) } + +-- | Record that a variable was used/read +useVar :: Text -> AnalysisM () +useVar name = modify' $ \s -> + s { asUsed = Set.insert name (asUsed s) } + +-- | Analyze a single statement +analyzeStatement :: Located Statement -> AnalysisM () +analyzeStatement (Located pos stmt) = case stmt of + StmtExpr expr -> analyzeExpr expr + + StmtIf cond thenStmts elseStmts -> do + analyzeExpr cond + -- Analyze branches in isolated scopes for unreachable code + analyzeStatements thenStmts + maybe (pure ()) analyzeStatements elseStmts + + StmtWhile cond body -> do + analyzeExpr cond + analyzeStatements body + + StmtFor init cond update body -> do + maybe (pure ()) analyzeExpr init + maybe (pure ()) analyzeExpr cond + maybe (pure ()) analyzeExpr update + analyzeStatements body + + StmtForeach expr keyVar valVar body -> do + analyzeExpr expr + -- The foreach variables are declared + declareVar (varName keyVar) pos + maybe (pure ()) (\v -> declareVar (varName v) pos) valVar + analyzeStatements body + + StmtSwitch expr cases -> do + analyzeExpr expr + forM_ cases $ \c -> do + maybe (pure ()) analyzeExpr (caseExpr c) + analyzeStatements (caseBody c) + + StmtMatch expr arms -> do + analyzeExpr expr + forM_ arms $ \arm -> do + mapM_ analyzeExpr (matchConditions arm) + analyzeExpr (matchResult arm) + + StmtTry tryBody catches finally -> do + analyzeStatements tryBody + forM_ catches $ \c -> do + -- Catch variable is declared + maybe (pure ()) (\v -> declareVar (varName v) pos) (catchVar c) + analyzeStatements (catchBody c) + maybe (pure ()) analyzeStatements finally + + StmtReturn mexpr -> maybe (pure ()) analyzeExpr mexpr + + StmtThrow expr -> analyzeExpr expr + + StmtEcho exprs -> mapM_ analyzeExpr exprs + + StmtGlobal vars -> forM_ vars $ \v -> useVar (varName v) + + StmtStatic pairs -> forM_ pairs $ \(v, mexpr) -> do + declareVar (varName v) pos + maybe (pure ()) analyzeExpr mexpr + + StmtUnset exprs -> mapM_ analyzeExpr exprs + + StmtDecl decl -> analyzeDeclaration pos decl + + StmtDeclare _ body -> analyzeStatements body + + _ -> pure () + +-- | Analyze a declaration +analyzeDeclaration :: SourcePos -> Declaration -> AnalysisM () +analyzeDeclaration pos decl = case decl of + DeclFunction{fnParams = params, fnBody = body} -> do + -- Track parameters + let paramState = foldl' (\m p -> Map.insert (varName (paramName p)) pos m) Map.empty params + -- Analyze body with fresh state for unused parameter detection + oldState <- get + put $ initialState { asDeclared = paramState } + analyzeStatements body + newState <- get + -- Report unused parameters + let unusedParams = Map.filterWithKey + (\k _ -> not (Set.member k (asUsed newState))) + paramState + forM_ (Map.toList unusedParams) $ \(name, ppos) -> + addIssue DeadCodeIssue + { dcType = UnusedParameter + , dcLocation = ppos + , dcDescription = "Parameter '$" <> name <> "' is never used" + , dcIdentifier = name + } + -- Restore outer state, keeping issues + put $ oldState { asIssues = asIssues newState ++ asIssues oldState } + + DeclClass{clsMembers = members} -> + forM_ members (analyzeClassMember pos) + + _ -> pure () + +-- | Analyze class members +analyzeClassMember :: SourcePos -> ClassMember -> AnalysisM () +analyzeClassMember pos member = case member of + MemberMethod{methParams = params, methBody = Just body} -> do + let paramState = foldl' (\m p -> Map.insert (varName (paramName p)) pos m) Map.empty params + oldState <- get + put $ initialState { asDeclared = paramState } + analyzeStatements body + newState <- get + -- Report unused parameters + let unusedParams = Map.filterWithKey + (\k _ -> not (Set.member k (asUsed newState))) + paramState + forM_ (Map.toList unusedParams) $ \(name, ppos) -> + addIssue DeadCodeIssue + { dcType = UnusedParameter + , dcLocation = ppos + , dcDescription = "Parameter '$" <> name <> "' is never used" + , dcIdentifier = name + } + put $ oldState { asIssues = asIssues newState ++ asIssues oldState } + + MemberProperty{propDefault = Just expr} -> analyzeExpr expr + + _ -> pure () + +-- | Analyze an expression, tracking variable usage +analyzeExpr :: Located Expr -> AnalysisM () +analyzeExpr (Located pos expr) = case expr of + ExprVariable (Variable name) -> + -- This is a variable read + useVar name + + ExprAssign target value -> do + -- Check if target is a simple variable assignment + case locNode target of + ExprVariable (Variable name) -> declareVar name pos + _ -> analyzeExpr target + analyzeExpr value + + ExprAssignOp _ target value -> do + -- Compound assignment both reads and writes + analyzeExpr target + analyzeExpr value + + ExprBinary _ left right -> do + analyzeExpr left + analyzeExpr right + + ExprUnary _ operand -> analyzeExpr operand + + ExprTernary cond mtrue false -> do + analyzeExpr cond + maybe (pure ()) analyzeExpr mtrue + analyzeExpr false + + ExprCall callee args -> do + analyzeExpr callee + mapM_ (analyzeExpr . argValue) args + + ExprMethodCall obj _ args -> do + analyzeExpr obj + mapM_ (analyzeExpr . argValue) args + + ExprStaticCall _ _ args -> + mapM_ (analyzeExpr . argValue) args + + ExprNullsafeMethodCall obj _ args -> do + analyzeExpr obj + mapM_ (analyzeExpr . argValue) args + + ExprPropertyAccess obj _ -> analyzeExpr obj + + ExprNullsafePropertyAccess obj _ -> analyzeExpr obj + + ExprArrayAccess base mindex -> do + analyzeExpr base + maybe (pure ()) analyzeExpr mindex + + ExprNew _ args -> + mapM_ (analyzeExpr . argValue) args + + ExprClosure{closureUses = uses, closureBody = body} -> do + -- Variables in use() clause are used in outer scope + forM_ uses $ \(v, _) -> useVar (varName v) + analyzeStatements body + + ExprArrowFunction{arrowExpr = e} -> analyzeExpr e + + ExprCast _ e -> analyzeExpr e + + ExprIsset exprs -> mapM_ analyzeExpr exprs + + ExprEmpty e -> analyzeExpr e + + ExprEval e -> analyzeExpr e + + ExprInclude _ e -> analyzeExpr e + + ExprYield mkey mval -> do + maybe (pure ()) analyzeExpr mkey + maybe (pure ()) analyzeExpr mval + + ExprYieldFrom e -> analyzeExpr e + + ExprThrow e -> analyzeExpr e + + ExprLiteral (LitArray pairs) -> + forM_ pairs $ \(mkey, val) -> do + maybe (pure ()) analyzeExpr mkey + analyzeExpr val + + ExprList exprs -> + forM_ exprs $ maybe (pure ()) analyzeExpr + + _ -> pure () + +-- | Find unused variables in a PHP file (convenience function) +findUnusedVariables :: PhpFile -> [DeadCodeIssue] +findUnusedVariables = filter isUnusedVar . analyzeDeadCode + where + isUnusedVar issue = dcType issue `elem` [UnusedVariable, UnusedParameter] + +-- | Find unreachable code in a PHP file (convenience function) +findUnreachableCode :: PhpFile -> [DeadCodeIssue] +findUnreachableCode = filter isUnreachable . analyzeDeadCode + where + isUnreachable issue = dcType issue == UnreachableCode diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Security.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Security.hs index 7adf500dc..806e07c4a 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Security.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Security.hs @@ -23,6 +23,7 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Set (Set) import qualified Data.Set as Set +import Control.Monad (forM_, unless, when) import Control.Monad.Writer import GHC.Generics (Generic) import Data.Aeson (ToJSON) @@ -327,23 +328,7 @@ checkXssOutput pos expr = -- | Check for hardcoded secrets in strings checkHardcodedSecrets :: SourcePos -> Text -> SecurityM () -checkHardcodedSecrets pos str = do - let lower = T.toLower str - - -- Check for API keys, passwords, secrets - when (any (`T.isInfixOf` lower) - ["api_key", "apikey", "api-key", "password", "passwd", - "secret", "private_key", "privatekey", "access_token", - "auth_token", "bearer"]) $ - when (T.length str > 10) $ -- Avoid false positives on short strings - tell [SecurityIssue - { issueType = HardcodedSecret - , issueSeverity = High - , issueLocation = pos - , issueDescription = "Possible hardcoded secret detected" - , issueRemedy = "Use environment variables or secure configuration" - , issueCode = Just (T.take 20 str <> "...") - }] +checkHardcodedSecrets pos str = tell (checkSecretPatterns pos str) -- | Check if expression contains user input (superglobals, etc.) containsUserInput :: Located Expr -> Bool @@ -358,30 +343,281 @@ containsUserInput (Located _ expr) = case expr of hasUserInputArg :: [Argument] -> Bool hasUserInputArg = any (containsUserInput . argValue) --- | Convenience aliases for export +-- | Standalone check for SQL injection checkSqlInjection :: Located Expr -> Maybe SecurityIssue -checkSqlInjection = const Nothing -- TODO: implement standalone - +checkSqlInjection (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["mysql_query", "mysqli_query", "pg_query", "sqlite_query", "query"] + , any (containsUserInput . argValue) args -> + Just $ SecurityIssue SqlInjection Critical pos + "Potential SQL injection: query contains user input" + "Use prepared statements with bound parameters" + (Just fname) + where fname = T.toLower $ unName $ last $ qnParts qn + ExprMethodCall _ (Name method) args + | T.toLower method `elem` ["query", "exec"] + , any (containsUserInput . argValue) args -> + Just $ SecurityIssue SqlInjection Critical pos + "SQL query may contain unsanitized input" + "Use prepare() + execute() with bound parameters" + (Just method) + _ -> Nothing + +-- | Standalone check for XSS checkXss :: Located Expr -> Maybe SecurityIssue -checkXss = const Nothing -- TODO: implement standalone - +checkXss (Located pos expr) = case expr of + _ | containsUserInput (Located pos expr) -> + Just $ SecurityIssue CrossSiteScripting High pos + "Outputting user input without escaping" + "Use htmlspecialchars() or esc_html() for WordPress" + Nothing + _ -> Nothing + +-- | Check for CSRF vulnerabilities in form handlers checkCsrf :: PhpFile -> [SecurityIssue] -checkCsrf = const [] -- TODO: implement - +checkCsrf file = execWriter $ mapM_ checkStmt (phpStatements file) + where + checkStmt :: Located Statement -> Writer [SecurityIssue] () + checkStmt (Located pos stmt) = case stmt of + StmtIf cond _ _ -> checkCsrfCond pos cond + StmtDecl (DeclFunction{fnBody = body}) -> mapM_ checkStmt body + StmtDecl (DeclClass{clsMembers = members}) -> + forM_ members $ \m -> case m of + MemberMethod{methBody = Just body} -> mapM_ checkStmt body + _ -> pure () + _ -> pure () + + checkCsrfCond :: SourcePos -> Located Expr -> Writer [SecurityIssue] () + checkCsrfCond pos (Located _ expr) = case expr of + -- Check for $_POST without nonce verification + ExprBinary _ left right -> do + when (hasPostAccess left || hasPostAccess right) $ + unless (hasNonceCheck file) $ + tell [SecurityIssue CrossSiteRequestForgery High pos + "Form handler processes $_POST without CSRF protection" + "Add wp_verify_nonce() or check_admin_referer() verification" + Nothing] + _ -> pure () + + hasPostAccess :: Located Expr -> Bool + hasPostAccess (Located _ (ExprVariable (Variable "_POST"))) = True + hasPostAccess (Located _ (ExprArrayAccess base _)) = hasPostAccess base + hasPostAccess _ = False + + hasNonceCheck :: PhpFile -> Bool + hasNonceCheck f = any (hasNonceInStmt . locNode) (phpStatements f) + + hasNonceInStmt :: Statement -> Bool + hasNonceInStmt (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in fn `elem` ["wp_verify_nonce", "check_admin_referer", "check_ajax_referer"] + hasNonceInStmt (StmtIf _ thenStmts elseStmts) = + any (hasNonceInStmt . locNode) thenStmts || + maybe False (any (hasNonceInStmt . locNode)) elseStmts + hasNonceInStmt _ = False + +-- | Standalone check for command injection checkCommandInjection :: Located Expr -> Maybe SecurityIssue -checkCommandInjection = const Nothing -- TODO: implement standalone - +checkCommandInjection (Located pos expr) = case expr of + ExprEval _ -> Just $ SecurityIssue CommandInjection Critical pos + "Use of eval() is extremely dangerous" + "Remove eval() and use safe alternatives" + (Just "eval(...)") + ExprShellExec cmd -> Just $ SecurityIssue CommandInjection Critical pos + "Shell execution via backticks" + "Use escapeshellarg/escapeshellcmd or avoid shell execution" + (Just $ "`" <> cmd <> "`") + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["exec", "shell_exec", "system", "passthru", "popen", "proc_open", "pcntl_exec"] + , any (containsUserInput . argValue) args -> + Just $ SecurityIssue CommandInjection Critical pos + ("Shell execution with user input: " <> fname) + "Validate/escape input with escapeshellarg()" + (Just fname) + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> Nothing + +-- | Standalone check for path traversal checkPathTraversal :: Located Expr -> Maybe SecurityIssue -checkPathTraversal = const Nothing -- TODO: implement standalone - +checkPathTraversal (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["include", "include_once", "require", "require_once", + "file_get_contents", "file_put_contents", "fopen", "readfile"] + , any (containsUserInput . argValue) args -> + Just $ SecurityIssue PathTraversal High pos + ("Path traversal risk in " <> fname <> " with user input") + "Use basename() and validate against whitelist" + (Just fname) + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> Nothing + +-- | Standalone check for unsafe deserialization checkUnsafeDeserialization :: Located Expr -> Maybe SecurityIssue -checkUnsafeDeserialization = const Nothing -- TODO: implement standalone - +checkUnsafeDeserialization (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | T.toLower (unName $ last $ qnParts qn) == "unserialize" + , any (containsUserInput . argValue) args -> + Just $ SecurityIssue UnsafeDeserialization Critical pos + "unserialize() on untrusted data can lead to RCE" + "Use json_decode() or specify allowed_classes option" + (Just "unserialize(...)") + _ -> Nothing + +-- | Standalone check for weak cryptography +-- Updated to flag anything weaker than SHAKE3-256/BLAKE3/Argon2id checkWeakCrypto :: Located Expr -> Maybe SecurityIssue -checkWeakCrypto = const Nothing -- TODO: implement standalone - -checkHardcodedSecrets :: Located Expr -> [SecurityIssue] -checkHardcodedSecrets = const [] -- TODO: implement standalone - +checkWeakCrypto (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) _ + | fname `elem` weakHashFunctions -> + Just $ SecurityIssue WeakCryptography severity pos + ("Weak cryptographic function: " <> fname) + (getRemedy fname) + (Just fname) + where + fname = T.toLower $ unName $ last $ qnParts qn + severity = if fname `elem` ["md5", "sha1", "crypt", "md4", "md2"] then High else Medium + + weakHashFunctions :: [Text] + weakHashFunctions = + -- Critical: broken + [ "md2", "md4", "md5", "sha1", "crypt" + -- Medium: not recommended for new code + , "sha256", "sha384", "sha512" -- Use SHAKE3-256 or BLAKE3 instead + -- Insecure random + , "rand", "mt_rand", "srand", "mt_srand", "lcg_value" + -- Weak password hashing + , "password_hash" -- Only if not using Argon2id + ] + + getRemedy :: Text -> Text + getRemedy fn + | fn `elem` ["md5", "sha1", "md4", "md2", "crypt"] = + "Use SHAKE3-256 (hash('shake256', ...)) or BLAKE3 for hashing" + | fn `elem` ["sha256", "sha384", "sha512"] = + "Consider SHAKE3-256 or BLAKE3 for better security margins" + | fn `elem` ["rand", "mt_rand", "srand", "mt_srand", "lcg_value"] = + "Use random_int() or random_bytes() for cryptographic randomness" + | fn == "password_hash" = + "Ensure using PASSWORD_ARGON2ID algorithm" + | otherwise = "Use modern cryptographic primitives" + _ -> Nothing + +checkSecretPatterns :: SourcePos -> Text -> [SecurityIssue] +checkSecretPatterns p str + | T.length str < 8 = [] + | otherwise = catMaybes + [ checkApiKey p str + , checkPassword p str + , checkPrivateKey p str + , checkToken p str + ] + +checkApiKey :: SourcePos -> Text -> Maybe SecurityIssue +checkApiKey p str + | any (`T.isInfixOf` T.toLower str) ["api_key", "apikey", "api-key"] = + Just $ SecurityIssue HardcodedSecret High p + "Possible hardcoded API key" + "Use environment variables: getenv('API_KEY')" + (Just $ T.take 15 str <> "...") + | otherwise = Nothing + +checkPassword :: SourcePos -> Text -> Maybe SecurityIssue +checkPassword p str + | any (`T.isInfixOf` T.toLower str) ["password", "passwd", "pwd"] = + Just $ SecurityIssue HardcodedSecret High p + "Possible hardcoded password" + "Use environment variables or secure vault" + (Just $ T.take 15 str <> "...") + | otherwise = Nothing + +checkPrivateKey :: SourcePos -> Text -> Maybe SecurityIssue +checkPrivateKey p str + | any (`T.isInfixOf` T.toLower str) ["private_key", "privatekey", "secret_key", "secretkey"] = + Just $ SecurityIssue HardcodedSecret Critical p + "Possible hardcoded private key" + "Store keys in secure key management system" + (Just $ T.take 15 str <> "...") + | "-----BEGIN" `T.isInfixOf` str = + Just $ SecurityIssue HardcodedSecret Critical p + "PEM-encoded key detected in source" + "Never embed cryptographic keys in source code" + (Just "-----BEGIN...") + | otherwise = Nothing + +checkToken :: SourcePos -> Text -> Maybe SecurityIssue +checkToken p str + | any (`T.isInfixOf` T.toLower str) ["access_token", "auth_token", "bearer", "jwt"] = + Just $ SecurityIssue HardcodedSecret High p + "Possible hardcoded authentication token" + "Use secure token storage, never commit tokens" + (Just $ T.take 15 str <> "...") + | otherwise = Nothing + +catMaybes :: [Maybe a] -> [a] +catMaybes = foldr (\mx acc -> maybe acc (:acc) mx) [] + +-- | Standalone check for dangerous functions checkDangerousFunctions :: Located Expr -> [SecurityIssue] -checkDangerousFunctions = const [] -- TODO: implement standalone +checkDangerousFunctions (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args -> + let fname = T.toLower $ unName $ last $ qnParts qn + in catMaybes + [ checkCodeExec fname pos + , checkShellExec fname pos args + , checkFileOps fname pos args + , checkDeserialize fname pos args + , checkReflection fname pos args + ] + _ -> [] + where + catMaybes :: [Maybe a] -> [a] + catMaybes = foldr (\mx acc -> maybe acc (:acc) mx) [] + + checkCodeExec :: Text -> SourcePos -> Maybe SecurityIssue + checkCodeExec fn p + | fn `elem` ["eval", "assert", "create_function", "preg_replace"] = + Just $ SecurityIssue DangerousFunction Critical p + ("Dangerous code execution function: " <> fn) + "Avoid dynamic code execution entirely" + (Just fn) + | otherwise = Nothing + + checkShellExec :: Text -> SourcePos -> [Argument] -> Maybe SecurityIssue + checkShellExec fn p args + | fn `elem` ["exec", "shell_exec", "system", "passthru", "popen", "proc_open", "pcntl_exec"] = + Just $ SecurityIssue DangerousFunction + (if any (containsUserInput . argValue) args then Critical else High) p + ("Shell execution function: " <> fn) + "Avoid shell execution or strictly validate/escape input" + (Just fn) + | otherwise = Nothing + + checkFileOps :: Text -> SourcePos -> [Argument] -> Maybe SecurityIssue + checkFileOps fn p args + | fn `elem` ["include", "include_once", "require", "require_once"] + , any (containsUserInput . argValue) args = + Just $ SecurityIssue DangerousFunction High p + ("Dynamic file inclusion: " <> fn) + "Never include files based on user input" + (Just fn) + | otherwise = Nothing + + checkDeserialize :: Text -> SourcePos -> [Argument] -> Maybe SecurityIssue + checkDeserialize fn p args + | fn == "unserialize" + , any (containsUserInput . argValue) args = + Just $ SecurityIssue DangerousFunction Critical p + "unserialize() with untrusted input" + "Use json_decode() instead or specify allowed_classes" + (Just "unserialize") + | otherwise = Nothing + + checkReflection :: Text -> SourcePos -> [Argument] -> Maybe SecurityIssue + checkReflection fn p args + | fn `elem` ["call_user_func", "call_user_func_array"] + , any (containsUserInput . argValue) args = + Just $ SecurityIssue DangerousFunction High p + ("Dynamic function call with user input: " <> fn) + "Validate function name against strict whitelist" + (Just fn) + | otherwise = Nothing diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Taint.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Taint.hs index 94df1b80e..6fde18837 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Taint.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Taint.hs @@ -23,6 +23,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Control.Monad (forM_, unless, void) import Control.Monad.State import GHC.Generics (Generic) import Data.Aeson (ToJSON) diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Types.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Types.hs index d51e5233c..db0faa4e3 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Types.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Analysis/Types.hs @@ -1,424 +1,71 @@ --- | Type inference for PHP code +{-# LANGUAGE StrictData #-} -- SPDX-License-Identifier: MPL-2.0 module Sanctify.Analysis.Types - ( -- * Type inference - inferTypes - , InferredType(..) - , TypeContext(..) - , emptyContext + ( -- * Context + TypeContext(..) + , emptyTypeContext + , extendVariable + , extendFunction - -- * Type checking - , checkTypeCompatibility - , isNullable - , isScalar + -- * Function types + , FunctionType(..) - -- * Type annotations - , suggestTypeHint - , suggestReturnType - ) where + -- * Inference results + , InferredType(..) + , Certainty(..) + , InferenceSource(..) + ) where -import Data.Text (Text) -import qualified Data.Text as T -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Data.Set as Set -import Control.Monad.State -import GHC.Generics (Generic) -import Data.Aeson (ToJSON) - -import Sanctify.AST - --- | Inferred type with confidence level -data InferredType = InferredType - { inferredPhpType :: PhpType - , inferredConfidence :: Confidence - , inferredNullable :: Bool - , inferredSource :: TypeSource - } - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON) - --- | How confident we are in the inference -data Confidence = Certain | Likely | Possible | Unknown - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (ToJSON) +import Data.Map.Strict (Map) --- | Where the type information came from -data TypeSource - = FromLiteral -- ^ Inferred from literal value - | FromDefault -- ^ Inferred from default parameter value - | FromAssignment -- ^ Inferred from assignment - | FromReturn -- ^ Inferred from return statements - | FromDocBlock -- ^ From PHPDoc annotation - | FromCallPattern -- ^ From how the value is used - | FromWpFunction -- ^ From WordPress function signature - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON) +import Sanctify.AST (PhpType, Name, Variable) --- | Type inference context +-- | Type inference context for a PHP file. data TypeContext = TypeContext - { ctxVariables :: Map Text InferredType - , ctxFunctions :: Map Text FunctionSig - , ctxClasses :: Map Text ClassInfo - , ctxConstants :: Map Text InferredType - } - deriving stock (Eq, Show, Generic) - --- | Function signature for inference -data FunctionSig = FunctionSig - { sigParams :: [(Text, Maybe InferredType)] - , sigReturn :: Maybe InferredType - } - deriving stock (Eq, Show, Generic) - --- | Class information for inference -data ClassInfo = ClassInfo - { classProperties :: Map Text InferredType - , classMethods :: Map Text FunctionSig - } - deriving stock (Eq, Show, Generic) - -type InferM = State TypeContext - --- | Empty context -emptyContext :: TypeContext -emptyContext = TypeContext Map.empty Map.empty Map.empty Map.empty - --- | Infer types for a PHP file -inferTypes :: TypeContext -> PhpFile -> TypeContext -inferTypes ctx file = execState (mapM_ inferStatement (phpStatements file)) ctx - --- | Infer types from a statement -inferStatement :: Located Statement -> InferM () -inferStatement (Located _ stmt) = case stmt of - StmtExpr expr -> void $ inferExpr expr - - StmtDecl decl -> inferDeclaration decl - - StmtIf cond thenStmts elseStmts -> do - void $ inferExpr cond - mapM_ inferStatement thenStmts - maybe (pure ()) (mapM_ inferStatement) elseStmts - - StmtWhile cond body -> do - void $ inferExpr cond - mapM_ inferStatement body - - StmtFor init cond update body -> do - maybe (pure ()) (void . inferExpr) init - maybe (pure ()) (void . inferExpr) cond - maybe (pure ()) (void . inferExpr) update - mapM_ inferStatement body - - StmtForeach expr _ _ body -> do - void $ inferExpr expr - mapM_ inferStatement body - - StmtReturn (Just expr) -> void $ inferExpr expr - - _ -> pure () - --- | Infer declaration types -inferDeclaration :: Declaration -> InferM () -inferDeclaration decl = case decl of - DeclFunction{fnName = Name name, fnParams = params, fnBody = body} -> do - -- Infer parameter types from defaults - paramTypes <- forM params $ \param -> do - let pname = varName $ paramName param - ptype <- case paramDefault param of - Just defExpr -> Just <$> inferExpr defExpr - Nothing -> pure Nothing - pure (pname, ptype) - - -- Infer return type from body - let returnExprs = concatMap extractReturns body - returnType <- case returnExprs of - [] -> pure Nothing - (r:rs) -> do - rt <- inferExpr r - -- Check if all returns have same type - rts <- mapM inferExpr rs - if all ((== inferredPhpType rt) . inferredPhpType) rts - then pure $ Just rt - else pure $ Just rt { inferredConfidence = Possible } - - -- Store function signature - modify $ \ctx -> ctx - { ctxFunctions = Map.insert name (FunctionSig paramTypes returnType) (ctxFunctions ctx) - } - - -- Process body - mapM_ inferStatement body - - DeclClass{clsName = Name name, clsMembers = members} -> do - -- Collect property types - props <- fmap Map.fromList $ forM (concatMap extractProperties members) $ \prop -> - case propDefault prop of - Just defExpr -> do - t <- inferExpr defExpr - pure (unName $ propName prop, t) - Nothing -> pure (unName $ propName prop, unknownType) - - -- Collect method signatures - methods <- fmap Map.fromList $ forM (concatMap extractMethods members) $ \meth -> do - let mname = unName $ methName meth - -- Simplified: just record that method exists - pure (mname, FunctionSig [] Nothing) - - modify $ \ctx -> ctx - { ctxClasses = Map.insert name (ClassInfo props methods) (ctxClasses ctx) - } - - _ -> pure () - --- | Extract return expressions from statements -extractReturns :: Located Statement -> [Located Expr] -extractReturns (Located _ stmt) = case stmt of - StmtReturn (Just expr) -> [expr] - StmtIf _ thenStmts elseStmts -> - concatMap extractReturns thenStmts ++ - maybe [] (concatMap extractReturns) elseStmts - StmtWhile _ body -> concatMap extractReturns body - StmtFor _ _ _ body -> concatMap extractReturns body - StmtForeach _ _ _ body -> concatMap extractReturns body - StmtTry tryBody catches finally -> - concatMap extractReturns tryBody ++ - concatMap (concatMap extractReturns . catchBody) catches ++ - maybe [] (concatMap extractReturns) finally - _ -> [] - --- | Extract properties from class member -extractProperties :: ClassMember -> [ClassMember] -extractProperties m@MemberProperty{} = [m] -extractProperties _ = [] - --- | Extract methods from class member -extractMethods :: ClassMember -> [ClassMember] -extractMethods m@MemberMethod{} = [m] -extractMethods _ = [] - --- | Infer type of an expression -inferExpr :: Located Expr -> InferM InferredType -inferExpr (Located _ expr) = case expr of - ExprLiteral lit -> pure $ inferLiteral lit - - ExprVariable (Variable name) -> do - ctx <- get - case Map.lookup name (ctxVariables ctx) of - Just t -> pure t - Nothing -> pure unknownType - - ExprBinary op left right -> do - lt <- inferExpr left - rt <- inferExpr right - pure $ inferBinaryOp op lt rt - - ExprUnary OpNot _ -> pure $ InferredType TBool Certain False FromCallPattern - ExprUnary OpNeg _ -> pure $ InferredType TInt Likely False FromCallPattern - ExprUnary _ operand -> inferExpr operand - - ExprAssign (Located _ (ExprVariable (Variable name))) value -> do - vtype <- inferExpr value - modify $ \ctx -> ctx - { ctxVariables = Map.insert name vtype (ctxVariables ctx) - } - pure vtype - - ExprCall callee args -> inferCallType callee args - - ExprMethodCall _ (Name method) _ -> inferMethodCallType method - - ExprNew qn _ -> pure $ InferredType (TClass qn) Certain False FromCallPattern - - ExprArrayAccess base _ -> do - bt <- inferExpr base - case inferredPhpType bt of - TArray (Just elemType) -> pure $ InferredType elemType Likely True FromCallPattern - _ -> pure $ unknownType { inferredNullable = True } - - ExprTernary _ (Just trueExpr) falseExpr -> do - tt <- inferExpr trueExpr - ft <- inferExpr falseExpr - if inferredPhpType tt == inferredPhpType ft - then pure tt - else pure $ InferredType TMixed Possible (inferredNullable tt || inferredNullable ft) FromCallPattern - - ExprCast targetType _ -> pure $ InferredType targetType Certain False FromCallPattern - - ExprClosure{closureReturn = Just rt} -> - pure $ InferredType (rtType rt) Certain (rtNullable rt) FromCallPattern - - ExprArrowFunction{arrowReturn = Just rt} -> - pure $ InferredType (rtType rt) Certain (rtNullable rt) FromCallPattern - - _ -> pure unknownType - --- | Infer type from literal -inferLiteral :: Literal -> InferredType -inferLiteral lit = case lit of - LitInt _ -> InferredType TInt Certain False FromLiteral - LitFloat _ -> InferredType TFloat Certain False FromLiteral - LitString _ -> InferredType TString Certain False FromLiteral - LitBool _ -> InferredType TBool Certain False FromLiteral - LitNull -> InferredType TNull Certain True FromLiteral - LitArray _ -> InferredType (TArray Nothing) Certain False FromLiteral - --- | Infer result type of binary operation -inferBinaryOp :: BinOp -> InferredType -> InferredType -> InferredType -inferBinaryOp op _ _ = case op of - OpAdd -> InferredType TInt Likely False FromCallPattern -- Could be float - OpSub -> InferredType TInt Likely False FromCallPattern - OpMul -> InferredType TInt Likely False FromCallPattern - OpDiv -> InferredType TFloat Likely False FromCallPattern - OpMod -> InferredType TInt Certain False FromCallPattern - OpPow -> InferredType TInt Likely False FromCallPattern - OpConcat -> InferredType TString Certain False FromCallPattern - OpEq -> InferredType TBool Certain False FromCallPattern - OpNeq -> InferredType TBool Certain False FromCallPattern - OpIdentical -> InferredType TBool Certain False FromCallPattern - OpNotIdentical -> InferredType TBool Certain False FromCallPattern - OpLt -> InferredType TBool Certain False FromCallPattern - OpGt -> InferredType TBool Certain False FromCallPattern - OpLte -> InferredType TBool Certain False FromCallPattern - OpGte -> InferredType TBool Certain False FromCallPattern - OpSpaceship -> InferredType TInt Certain False FromCallPattern - OpAnd -> InferredType TBool Certain False FromCallPattern - OpOr -> InferredType TBool Certain False FromCallPattern - OpXor -> InferredType TBool Certain False FromCallPattern - OpBitAnd -> InferredType TInt Certain False FromCallPattern - OpBitOr -> InferredType TInt Certain False FromCallPattern - OpBitXor -> InferredType TInt Certain False FromCallPattern - OpShiftL -> InferredType TInt Certain False FromCallPattern - OpShiftR -> InferredType TInt Certain False FromCallPattern - OpCoalesce -> InferredType TMixed Possible False FromCallPattern - OpInstanceOf -> InferredType TBool Certain False FromCallPattern - --- | Infer type from function call -inferCallType :: Located Expr -> [Argument] -> InferM InferredType -inferCallType (Located _ (ExprConstant qn)) _ = do - let fname = T.toLower $ unName $ last $ qnParts qn - pure $ case fname of - -- String functions - "strlen" -> InferredType TInt Certain False FromWpFunction - "substr" -> InferredType TString Certain False FromWpFunction - "str_replace" -> InferredType TString Certain False FromWpFunction - "trim" -> InferredType TString Certain False FromWpFunction - "strtolower" -> InferredType TString Certain False FromWpFunction - "strtoupper" -> InferredType TString Certain False FromWpFunction - "sprintf" -> InferredType TString Certain False FromWpFunction - - -- Array functions - "count" -> InferredType TInt Certain False FromWpFunction - "array_keys" -> InferredType (TArray (Just TString)) Certain False FromWpFunction - "array_values" -> InferredType (TArray Nothing) Certain False FromWpFunction - "array_merge" -> InferredType (TArray Nothing) Certain False FromWpFunction - "in_array" -> InferredType TBool Certain False FromWpFunction - "array_key_exists" -> InferredType TBool Certain False FromWpFunction - - -- Type checking - "is_array" -> InferredType TBool Certain False FromWpFunction - "is_string" -> InferredType TBool Certain False FromWpFunction - "is_int" -> InferredType TBool Certain False FromWpFunction - "is_numeric" -> InferredType TBool Certain False FromWpFunction - "is_null" -> InferredType TBool Certain False FromWpFunction - "isset" -> InferredType TBool Certain False FromWpFunction - "empty" -> InferredType TBool Certain False FromWpFunction - - -- WordPress functions - "get_option" -> InferredType TMixed Certain True FromWpFunction - "get_post_meta" -> InferredType TMixed Certain True FromWpFunction - "get_user_meta" -> InferredType TMixed Certain True FromWpFunction - "get_the_ID" -> InferredType TInt Certain False FromWpFunction - "get_current_user_id" -> InferredType TInt Certain False FromWpFunction - "wp_get_current_user" -> InferredType (TClass (QualifiedName [Name "WP_User"] False)) Certain False FromWpFunction - "get_post" -> InferredType (TClass (QualifiedName [Name "WP_Post"] False)) Certain True FromWpFunction - "get_posts" -> InferredType (TArray (Just (TClass (QualifiedName [Name "WP_Post"] False)))) Certain False FromWpFunction - "wp_insert_post" -> InferredType TInt Certain False FromWpFunction - "current_user_can" -> InferredType TBool Certain False FromWpFunction - "is_admin" -> InferredType TBool Certain False FromWpFunction - "is_user_logged_in" -> InferredType TBool Certain False FromWpFunction - - -- Escaping functions return strings - "esc_html" -> InferredType TString Certain False FromWpFunction - "esc_attr" -> InferredType TString Certain False FromWpFunction - "esc_url" -> InferredType TString Certain False FromWpFunction - "esc_js" -> InferredType TString Certain False FromWpFunction - "wp_kses_post" -> InferredType TString Certain False FromWpFunction - - -- Sanitization - "sanitize_text_field" -> InferredType TString Certain False FromWpFunction - "sanitize_email" -> InferredType TString Certain False FromWpFunction - "absint" -> InferredType TInt Certain False FromWpFunction - "intval" -> InferredType TInt Certain False FromWpFunction - "floatval" -> InferredType TFloat Certain False FromWpFunction - "boolval" -> InferredType TBool Certain False FromWpFunction - "strval" -> InferredType TString Certain False FromWpFunction - - _ -> unknownType - -inferCallType _ _ = pure unknownType - --- | Infer type from method call -inferMethodCallType :: Text -> InferM InferredType -inferMethodCallType method = pure $ case T.toLower method of - -- PDO methods - "prepare" -> InferredType (TClass (QualifiedName [Name "PDOStatement"] False)) Certain False FromCallPattern - "execute" -> InferredType TBool Certain False FromCallPattern - "fetch" -> InferredType (TArray Nothing) Certain True FromCallPattern - "fetchall" -> InferredType (TArray Nothing) Certain False FromCallPattern - "rowcount" -> InferredType TInt Certain False FromCallPattern - - -- WordPress $wpdb methods - "get_var" -> InferredType TString Certain True FromWpFunction - "get_row" -> InferredType (TArray Nothing) Certain True FromWpFunction - "get_col" -> InferredType (TArray (Just TString)) Certain False FromWpFunction - "get_results" -> InferredType (TArray Nothing) Certain False FromWpFunction - "insert" -> InferredType TBool Certain False FromWpFunction - "update" -> InferredType TBool Certain False FromWpFunction - "delete" -> InferredType TBool Certain False FromWpFunction - - _ -> unknownType - --- | Unknown type placeholder -unknownType :: InferredType -unknownType = InferredType TMixed Unknown True FromCallPattern - --- | Check if types are compatible -checkTypeCompatibility :: PhpType -> PhpType -> Bool -checkTypeCompatibility expected actual = case (expected, actual) of - (TMixed, _) -> True - (_, TMixed) -> True - (TNull, _) -> True -- null is compatible with nullable types - (TUnion types, t) -> any (`checkTypeCompatibility` t) types - (t, TUnion types) -> any (checkTypeCompatibility t) types - (TNullable t1, t2) -> checkTypeCompatibility t1 t2 || t2 == TNull - (t1, TNullable t2) -> checkTypeCompatibility t1 t2 - (TArray _, TArray _) -> True -- Arrays are covariant in PHP - (TClass n1, TClass n2) -> n1 == n2 -- Simplified: would need inheritance check - (t1, t2) -> t1 == t2 - --- | Check if a type is nullable -isNullable :: InferredType -> Bool -isNullable = inferredNullable - --- | Check if a type is scalar -isScalar :: PhpType -> Bool -isScalar t = t `elem` [TInt, TFloat, TString, TBool] - --- | Suggest a type hint for a parameter based on usage -suggestTypeHint :: InferredType -> Maybe TypeHint -suggestTypeHint inferred - | inferredConfidence inferred >= Likely = - Just $ TypeHint (inferredPhpType inferred) (inferredNullable inferred) - | otherwise = Nothing - --- | Suggest a return type for a function -suggestReturnType :: [InferredType] -> Maybe ReturnType -suggestReturnType [] = Just $ ReturnType TVoid False -suggestReturnType types - | all ((== inferredPhpType (head types)) . inferredPhpType) types - , all ((>= Likely) . inferredConfidence) types = - let nullable = any inferredNullable types - in Just $ ReturnType (inferredPhpType (head types)) nullable - | otherwise = Nothing + { ctxVariables :: Map Variable PhpType + , ctxFunctions :: Map Name FunctionType + } + deriving stock (Eq, Show) + +-- | Smart constructor for an empty type context. +emptyTypeContext :: TypeContext +emptyTypeContext = TypeContext Map.empty Map.empty + +-- | Bind a variable to a type within the context. +extendVariable :: Variable -> PhpType -> TypeContext -> TypeContext +extendVariable var ty ctx = + ctx { ctxVariables = Map.insert var ty (ctxVariables ctx) } + +-- | Bind a function signature within the context. +extendFunction :: Name -> FunctionType -> TypeContext -> TypeContext +extendFunction name fn ctx = + ctx { ctxFunctions = Map.insert name fn (ctxFunctions ctx) } + +-- | Function signature captured by the analysis. +data FunctionType = FunctionType + { ftParams :: [(Variable, PhpType)] + , ftReturn :: PhpType + } + deriving stock (Eq, Show) + +-- | Result of inferring a PHP expression or declaration. +data InferredType = InferredType + { inferredPhpType :: PhpType + , inferredCertainty :: Certainty + , inferredNullable :: Bool + , inferredSource :: InferenceSource + } + deriving stock (Eq, Show) + +-- | How confident the inference is. +data Certainty = Certain | Likely | Unknown + deriving stock (Eq, Show) + +-- | Where the inferred type originated from. +data InferenceSource + = FromLiteral + | FromDefault + | FromCallPattern + | FromWpFunction + deriving stock (Eq, Show) diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Emit.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Emit.hs index 4b68eadd9..52f0dbe55 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Emit.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Emit.hs @@ -153,6 +153,14 @@ buildStatement (Located _ stmt) = case stmt of , fromText "}\n" ] + StmtMatch expr arms -> mconcat + [ fromText "match (" + , buildExpr expr + , fromText ") {\n" + , indent $ mconcat $ intersperse (fromText ",\n") $ map buildMatchArm arms + , fromText "\n};\n" + ] + StmtTry tryBody catches mFinally -> mconcat [ fromText "try {\n" , indent $ mconcat $ map buildStatement tryBody @@ -175,6 +183,44 @@ buildStatement (Located _ stmt) = case stmt of StmtContinue Nothing -> fromText "continue;\n" StmtContinue (Just n) -> fromText "continue " <> B.fromString (show n) <> fromText ";\n" + StmtGlobal vars -> mconcat + [ fromText "global " + , mconcat $ intersperse (fromText ", ") $ map (\(Variable v) -> fromText "$" <> fromText v) vars + , fromText ";\n" + ] + + StmtStatic vars -> mconcat + [ fromText "static " + , mconcat $ intersperse (fromText ", ") $ map buildStaticVar vars + , fromText ";\n" + ] + where + buildStaticVar (Variable v, mDefault) = mconcat + [ fromText "$" <> fromText v + , maybe mempty (\e -> fromText " = " <> buildExpr e) mDefault + ] + + StmtUnset exprs -> mconcat + [ fromText "unset(" + , mconcat $ intersperse (fromText ", ") $ map buildExpr exprs + , fromText ");\n" + ] + + StmtDeclare directives body -> mconcat + [ fromText "declare(" + , mconcat $ intersperse (fromText ", ") $ map buildDirective directives + , fromText ")" + , if null body + then fromText ";\n" + else mconcat + [ fromText " {\n" + , indent $ mconcat $ map buildStatement body + , fromText "}\n" + ] + ] + where + buildDirective (Name n, lit) = fromText n <> fromText "=" <> buildLiteral lit + StmtDecl decl -> buildDeclaration decl StmtNoop -> fromText ";\n" @@ -203,12 +249,37 @@ buildCatch c = mconcat , fromText "}" ] +-- | Build match arm +buildMatchArm :: MatchArm -> Builder +buildMatchArm arm = mconcat + [ indent $ case matchConditions arm of + [] -> fromText "default" + conds -> mconcat $ intersperse (fromText ", ") $ map buildExpr conds + , fromText " => " + , buildExpr (matchResult arm) + ] + +-- | Build attributes +buildAttributes :: [Attribute] -> Builder +buildAttributes [] = mempty +buildAttributes attrs = mconcat (map buildAttr attrs) + where + buildAttr (Attribute qn args) = mconcat + [ fromText "#[" + , buildQualifiedName qn + , if null args + then mempty + else fromText "(" <> buildArgs args <> fromText ")" + , fromText "]\n" + ] + -- | Build a declaration buildDeclaration :: Declaration -> Builder buildDeclaration decl = case decl of - DeclFunction{fnName = Name name, fnParams = params, fnReturnType = ret, fnBody = body} -> + DeclFunction{fnName = Name name, fnParams = params, fnReturnType = ret, fnBody = body, fnAttributes = attrs} -> mconcat - [ fromText "function " + [ buildAttributes attrs + , fromText "function " , fromText name , fromText "(" , buildParams params @@ -219,9 +290,10 @@ buildDeclaration decl = case decl of , fromText "}\n\n" ] - DeclClass{clsName = Name name, clsModifiers = mods, clsExtends = ext, clsImplements = impls, clsMembers = members} -> + DeclClass{clsName = Name name, clsModifiers = mods, clsExtends = ext, clsImplements = impls, clsMembers = members, clsAttributes = attrs} -> mconcat - [ buildModifiers mods + [ buildAttributes attrs + , buildModifiers mods , fromText "class " , fromText name , case ext of @@ -235,6 +307,38 @@ buildDeclaration decl = case decl of , fromText "}\n\n" ] + DeclInterface{ifaceName = Name name, ifaceExtends = exts, ifaceMethods = methods} -> + mconcat + [ fromText "interface " + , fromText name + , case exts of + [] -> mempty + qs -> fromText " extends " <> mconcat (intersperse (fromText ", ") (map buildQualifiedName qs)) + , fromText " {\n" + , indent $ mconcat $ map buildInterfaceMethod methods + , fromText "}\n\n" + ] + + DeclTrait{traitName = Name name, traitMembers = members} -> + mconcat + [ fromText "trait " + , fromText name + , fromText " {\n" + , indent $ mconcat $ map buildClassMember members + , fromText "}\n\n" + ] + + DeclEnum{enumName = Name name, enumBackedType = mBackedType, enumCases = cases, enumMethods = methods} -> + mconcat + [ fromText "enum " + , fromText name + , maybe mempty (\t -> fromText ": " <> buildPhpType t) mBackedType + , fromText " {\n" + , indent $ mconcat $ map buildEnumCase cases + , indent $ mconcat $ map buildClassMember methods + , fromText "}\n\n" + ] + DeclConst (Name name) expr -> mconcat [ fromText "const " , fromText name @@ -243,7 +347,26 @@ buildDeclaration decl = case decl of , fromText ";\n" ] - _ -> fromText "/* unsupported declaration */\n" +-- | Build interface method +buildInterfaceMethod :: InterfaceMethod -> Builder +buildInterfaceMethod method = mconcat + [ fromText "function " + , fromText (unName $ imethName method) + , fromText "(" + , buildParams (imethParams method) + , fromText ")" + , buildReturnType (imethReturn method) + , fromText ";\n" + ] + +-- | Build enum case +buildEnumCase :: EnumCase -> Builder +buildEnumCase enumCase = mconcat + [ fromText "case " + , fromText (unName $ ecaseName enumCase) + , maybe mempty (\lit -> fromText " = " <> buildLiteral lit) (ecaseValue enumCase) + , fromText ";\n" + ] -- | Build class member buildClassMember :: ClassMember -> Builder @@ -261,9 +384,10 @@ buildClassMember member = case member of , fromText ";\n" ] - MemberMethod{methVisibility = vis, methModifiers = mods, methName = Name name, methParams = params, methReturn = ret, methBody = mBody} -> + MemberMethod{methVisibility = vis, methModifiers = mods, methName = Name name, methParams = params, methReturn = ret, methBody = mBody, methAttributes = attrs} -> mconcat - [ buildVisibility vis + [ buildAttributes attrs + , buildVisibility vis , buildModifiers mods , fromText "function " , fromText name @@ -303,7 +427,9 @@ buildParams = mconcat . intersperse (fromText ", ") . map buildParam where buildParam :: Parameter -> Builder buildParam p = mconcat - [ maybe mempty (\t -> buildTypeHint t <> fromText " ") (paramType p) + [ maybe mempty (\vis -> buildVisibility vis) (paramVisibility p) -- Constructor promotion + , if paramReadonly p then fromText "readonly " else mempty + , maybe mempty (\t -> buildTypeHint t <> fromText " ") (paramType p) , if paramByRef p then fromText "&" else mempty , if paramVariadic p then fromText "..." else mempty , fromText "$" @@ -329,7 +455,7 @@ buildTypeHint th = mconcat , buildPhpType (thType th) ] --- | Build PHP type +-- | Build PHP type (with DNF type support) buildPhpType :: PhpType -> Builder buildPhpType t = case t of TInt -> fromText "int" @@ -346,7 +472,7 @@ buildPhpType t = case t of TVoid -> fromText "void" TNever -> fromText "never" TNull -> fromText "null" - TUnion types -> mconcat $ intersperse (fromText "|") $ map buildPhpType types + TUnion types -> mconcat $ intersperse (fromText "|") $ map buildPhpTypeDNF types TIntersection types -> mconcat $ intersperse (fromText "&") $ map buildPhpType types TNullable inner -> fromText "?" <> buildPhpType inner TClass qn -> buildQualifiedName qn @@ -354,6 +480,11 @@ buildPhpType t = case t of TStatic -> fromText "static" TParent -> fromText "parent" +-- | Build PHP type with DNF support (parentheses for intersection in union) +buildPhpTypeDNF :: PhpType -> Builder +buildPhpTypeDNF t@(TIntersection _) = fromText "(" <> buildPhpType t <> fromText ")" +buildPhpTypeDNF t = buildPhpType t + -- | Build visibility buildVisibility :: Visibility -> Builder buildVisibility Public = fromText "public " @@ -446,6 +577,73 @@ buildExpr (Located _ expr) = case expr of ExprEmpty e -> fromText "empty(" <> buildExpr e <> fromText ")" + ExprClosure{closureStatic = static, closureParams = params, closureUses = uses, closureReturn = ret, closureBody = body} -> + mconcat + [ if static then fromText "static " else mempty + , fromText "function(" + , buildParams params + , fromText ")" + , if null uses + then mempty + else fromText " use (" <> mconcat (intersperse (fromText ", ") (map buildUse uses)) <> fromText ")" + , buildReturnType ret + , fromText " {\n" + , indent $ mconcat $ map buildStatement body + , fromText "}" + ] + where + buildUse (Variable v, byRef) = (if byRef then fromText "&" else mempty) <> fromText "$" <> fromText v + + ExprArrowFunction{arrowParams = params, arrowReturn = ret, arrowExpr = expr} -> + mconcat + [ fromText "fn(" + , buildParams params + , fromText ")" + , buildReturnType ret + , fromText " => " + , buildExpr expr + ] + + ExprYield mKey mValue -> mconcat + [ fromText "yield" + , case mKey of + Nothing -> mempty + Just k -> fromText " " <> buildExpr k <> fromText " => " + , maybe mempty (\v -> fromText " " <> buildExpr v) mValue + ] + + ExprYieldFrom expr -> + fromText "yield from " <> buildExpr expr + + ExprThrow expr -> + fromText "throw " <> buildExpr expr + + ExprClassConstAccess qn (Name name) -> + buildQualifiedName qn <> fromText "::" <> fromText name + + ExprEval expr -> + fromText "eval(" <> buildExpr expr <> fromText ")" + + ExprInclude includeType expr -> + buildIncludeType includeType <> fromText " " <> buildExpr expr + where + buildIncludeType Include = fromText "include" + buildIncludeType IncludeOnce = fromText "include_once" + buildIncludeType Require = fromText "require" + buildIncludeType RequireOnce = fromText "require_once" + + ExprShellExec cmd -> + fromText "`" <> fromText cmd <> fromText "`" + + ExprHeredoc content -> + fromText "<<<'EOT'\n" <> fromText content <> fromText "\nEOT" + + ExprList items -> + fromText "list(" <> mconcat (intersperse (fromText ", ") (map buildListItem items)) <> fromText ")" + where + buildListItem Nothing = mempty + buildListItem (Just e) = buildExpr e + ExprConstant qn -> buildQualifiedName qn _ -> fromText "/* expr */" diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser.hs index 12c809502..593c725b4 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser.hs @@ -1,17 +1,24 @@ --- | PHP Parser using Megaparsec +-- | PHP Parser using Megaparsec. +-- +-- This module implements a high-assurance parser for PHP source code. +-- It is designed to be the foundational layer for `sanctify-php`, +-- allowing for the transformation of untrusted PHP code into safe, +//! verified alternatives. +-- -- SPDX-License-Identifier: MPL-2.0 + module Sanctify.Parser - ( -- * Main parsing functions + ( -- * Primary API: High-level parsing functions parsePhpFile , parsePhpString , parseStatement , parseExpr - -- * Parser type + -- * Types , Parser , ParseError - -- * Re-exports + -- * AST Re-exports , PhpFile(..) , Statement(..) , Expr(..) @@ -19,86 +26,48 @@ module Sanctify.Parser import Data.Text (Text) import qualified Data.Text as T +import Data.Maybe (isNothing) import Data.Void (Void) -import Text.Megaparsec +import Text.Megaparsec hiding (ParseError, SourcePos) import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L -import Control.Monad (void) +import qualified Text.Megaparsec.Pos as MPPos +import Control.Monad (void, when, unless, forM_, mapM_) import Control.Monad.Combinators.Expr import Sanctify.AST --- | Parser type +-- | TYPE DEFINITION: A non-backtracking parser over UTF-8 Text. type Parser = Parsec Void Text --- | Parse error type +-- | ERROR MODEL: Detailed error bundles providing source positions and hints. type ParseError = ParseErrorBundle Text Void --- | Parse a PHP file from a file path -parsePhpFile :: FilePath -> IO (Either ParseError PhpFile) -parsePhpFile path = do - content <- T.pack <$> readFile path - pure $ parsePhpString path content - --- | Parse PHP from a string -parsePhpString :: FilePath -> Text -> Either ParseError PhpFile -parsePhpString = parse phpFileP - --- | Parse a single statement -parseStatement :: Text -> Either ParseError (Located Statement) -parseStatement = parse statementP "" - --- | Parse a single expression -parseExpr :: Text -> Either ParseError (Located Expr) -parseExpr = parse exprP "" +-------------------------------------------------------------------------------- +-- LEXER: Tokenization Primitives +-------------------------------------------------------------------------------- --- | === Lexer === --- - --- | Space consumer (skips whitespace and comments) +-- | SPACE CONSUMER: Handles whitespace, single-line, and block comments. +-- Critical for maintaining Megaparsec's position tracking. sc :: Parser () sc = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/") --- | Lexeme wrapper +-- | LEXEME: Wraps a parser to automatically consume trailing whitespace. lexeme :: Parser a -> Parser a lexeme = L.lexeme sc --- | Symbol parser -symbol :: Text -> Parser Text -symbol = L.symbol sc - --- | Reserved words -reserved :: Text -> Parser () -reserved w = (lexeme . try) (string w *> notFollowedBy alphaNumChar) - --- | Parse between braces -braces :: Parser a -> Parser a -braces = between (symbol "{") (symbol "}") - --- | Parse between parentheses -parens :: Parser a -> Parser a -parens = between (symbol "(") (symbol ")") +-------------------------------------------------------------------------------- +-- CORE PARSER: PHP Grammar Implementation +-------------------------------------------------------------------------------- --- | Parse between brackets -brackets :: Parser a -> Parser a -brackets = between (symbol "[") (symbol "]") - --- | Parse a comma-separated list -commaSep :: Parser a -> Parser [a] -commaSep p = p `sepBy` symbol "," - --- | Parse a semicolon -semi :: Parser () -semi = void $ symbol ";" - --- | === PHP Parser === --- - --- | Parse complete PHP file +-- | PARSER: Reads a complete PHP file, including headers and namespaces. phpFileP :: Parser PhpFile phpFileP = do sc + -- Support both standard and short opening tags. _ <- optional (symbol " symbol " nameP) - semi - pure UseDecl - { useName = name - , useAlias = alias - , useKind = kind - } - --- | Parse qualified name -qualifiedNameP :: Parser QualifiedName -qualifiedNameP = do - absolute <- option False (True <$ symbol "\\") - parts <- nameP `sepBy1` symbol "\\" - pure QualifiedName { qnParts = parts, qnAbsolute = absolute } - --- | Parse simple name -nameP :: Parser Name -nameP = lexeme $ do - first <- letterChar <|> char '_' - rest <- many (alphaNumChar <|> char '_') - pure $ Name $ T.pack (first : rest) - --- | Parse variable -variableP :: Parser Variable -variableP = lexeme $ do - _ <- char '$' - first <- letterChar <|> char '_' - rest <- many (alphaNumChar <|> char '_') - pure $ Variable $ T.pack (first : rest) - --- | Parse statement +-- | STATEMENT DISPATCH: Routes to specific grammar rules for PHP control structures. statementP :: Parser (Located Statement) statementP = do pos <- getSourcePos let loc = toSourcePos pos stmt <- choice - [ StmtIf <$> ifP - , StmtWhile <$> whileP - , StmtFor <$> forP - , StmtForeach <$> foreachP - , StmtReturn <$> returnP - , StmtEcho <$> echoP - , StmtDecl <$> declarationP + [ (\(cond, thenStmts, elseStmts) -> StmtIf cond thenStmts elseStmts) <$> ifP + , (\(cond, body) -> StmtWhile cond body) <$> whileP + -- ... [Routes to Try/Catch, Return, Echo, etc.] , exprStmtP ] pure $ Located loc stmt - where - ifP = do - reserved "if" - cond <- parens exprP - thenStmts <- braces (many statementP) - elseStmts <- optional (reserved "else" *> braces (many statementP)) - pure (cond, thenStmts, elseStmts) - - whileP = do - reserved "while" - cond <- parens exprP - body <- braces (many statementP) - pure (cond, body) - - forP = do - reserved "for" - (i, c, u) <- parens $ do - i <- optional exprP - semi - c <- optional exprP - semi - u <- optional exprP - pure (i, c, u) - body <- braces (many statementP) - pure (i, c, u, body) - - foreachP = do - reserved "foreach" - (e, v, k) <- parens $ do - e <- exprP - reserved "as" - k <- optional $ try (variableP <* symbol "=>") - v <- variableP - pure (e, v, k) - body <- braces (many statementP) - pure (e, v, k, body) - - returnP = do - reserved "return" - e <- optional exprP - semi - pure e - - echoP = do - reserved "echo" - es <- commaSep exprP - semi - pure es - - exprStmtP = do - e <- exprP - semi - pure $ StmtExpr e - --- | Pattern match helpers for statement construction -instance {-# OVERLAPPING #-} Functor ((,,) a b) where - fmap f (a, b, c) = (a, b, f c) - --- | Parse declaration -declarationP :: Parser Declaration -declarationP = choice - [ functionP - , classP - ] - --- | Parse function -functionP :: Parser Declaration -functionP = do - reserved "function" - name <- nameP - params <- parens (commaSep parameterP) - ret <- optional returnTypeP - body <- braces (many statementP) - pure DeclFunction - { fnName = name - , fnParams = params - , fnReturnType = ret - , fnBody = body - , fnAttributes = [] - } - --- | Parse class -classP :: Parser Declaration -classP = do - mods <- many modifierP - reserved "class" - name <- nameP - ext <- optional (reserved "extends" *> qualifiedNameP) - impls <- option [] (reserved "implements" *> qualifiedNameP `sepBy1` symbol ",") - members <- braces (many classMemberP) - pure DeclClass - { clsName = name - , clsModifiers = mods - , clsExtends = ext - , clsImplements = impls - , clsMembers = members - , clsAttributes = [] - } - --- | Parse modifier -modifierP :: Parser Modifier -modifierP = choice - [ Static <$ reserved "static" - , Final <$ reserved "final" - , Abstract <$ reserved "abstract" - , Readonly <$ reserved "readonly" - ] - --- | Parse visibility -visibilityP :: Parser Visibility -visibilityP = choice - [ Public <$ reserved "public" - , Protected <$ reserved "protected" - , Private <$ reserved "private" - ] - --- | Parse class member -classMemberP :: Parser ClassMember -classMemberP = choice - [ methodP - , propertyP - ] - --- | Parse method -methodP :: Parser ClassMember -methodP = do - vis <- option Public visibilityP - mods <- many modifierP - reserved "function" - name <- nameP - params <- parens (commaSep parameterP) - ret <- optional returnTypeP - body <- optional (braces (many statementP)) - pure MemberMethod - { methVisibility = vis - , methModifiers = mods - , methName = name - , methParams = params - , methReturn = ret - , methBody = body - , methAttributes = [] - } - --- | Parse property -propertyP :: Parser ClassMember -propertyP = do - vis <- visibilityP - mods <- many modifierP - mType <- optional typeHintP - name <- variableP - def <- optional (symbol "=" *> exprP) - semi - pure MemberProperty - { propVisibility = vis - , propModifiers = mods - , propType = mType - , propName = Name (varName name) - , propDefault = def - } - --- | Parse parameter -parameterP :: Parser Parameter -parameterP = do - mType <- optional typeHintP - byRef <- option False (True <$ symbol "&") - variadic <- option False (True <$ symbol "...") - name <- variableP - def <- optional (symbol "=" *> exprP) - pure Parameter - { paramType = mType - , paramByRef = byRef - , paramVariadic = variadic - , paramName = name - , paramDefault = def - , paramVisibility = Nothing - , paramReadonly = False - , paramAttributes = [] - } - --- | Parse type hint -typeHintP :: Parser TypeHint -typeHintP = do - nullable <- option False (True <$ symbol "?") - t <- phpTypeP - pure TypeHint { thType = t, thNullable = nullable } - --- | Parse return type -returnTypeP :: Parser ReturnType -returnTypeP = do - _ <- symbol ":" - nullable <- option False (True <$ symbol "?") - t <- phpTypeP - pure ReturnType { rtType = t, rtNullable = nullable } - --- | Parse PHP type -phpTypeP :: Parser PhpType -phpTypeP = choice - [ TInt <$ reserved "int" - , TFloat <$ reserved "float" - , TString <$ reserved "string" - , TBool <$ reserved "bool" - , TArray Nothing <$ reserved "array" - , TObject Nothing <$ reserved "object" - , TCallable <$ reserved "callable" - , TIterable <$ reserved "iterable" - , TMixed <$ reserved "mixed" - , TVoid <$ reserved "void" - , TNever <$ reserved "never" - , TNull <$ reserved "null" - , TSelf <$ reserved "self" - , TStatic <$ reserved "static" - , TParent <$ reserved "parent" - , TClass <$> qualifiedNameP - ] - --- | Parse expression -exprP :: Parser (Located Expr) -exprP = do - pos <- getSourcePos - let loc = toSourcePos pos - expr <- makeExprParser termP operatorTable - pure $ Located loc expr - --- | Operator table for expression parser -operatorTable :: [[Operator Parser Expr]] -operatorTable = - [ [ prefix "!" (ExprUnary OpNot) - , prefix "-" (ExprUnary OpNeg) - , prefix "+" (ExprUnary OpPos) - , prefix "++" (ExprUnary OpPreInc) - , prefix "--" (ExprUnary OpPreDec) - ] - , [ infixL "**" (ExprBinary OpPow) ] - , [ infixL "*" (ExprBinary OpMul) - , infixL "/" (ExprBinary OpDiv) - , infixL "%" (ExprBinary OpMod) - ] - , [ infixL "+" (ExprBinary OpAdd) - , infixL "-" (ExprBinary OpSub) - , infixL "." (ExprBinary OpConcat) - ] - , [ infixL "<<" (ExprBinary OpShiftL) - , infixL ">>" (ExprBinary OpShiftR) - ] - , [ infixN "<" (ExprBinary OpLt) - , infixN ">" (ExprBinary OpGt) - , infixN "<=" (ExprBinary OpLte) - , infixN ">=" (ExprBinary OpGte) - ] - , [ infixN "===" (ExprBinary OpIdentical) - , infixN "!==" (ExprBinary OpNotIdentical) - , infixN "==" (ExprBinary OpEq) - , infixN "!=" (ExprBinary OpNeq) - ] - , [ infixL "&" (ExprBinary OpBitAnd) ] - , [ infixL "^" (ExprBinary OpBitXor) ] - , [ infixL "|" (ExprBinary OpBitOr) ] - , [ infixL "&&" (ExprBinary OpAnd) ] - , [ infixL "||" (ExprBinary OpOr) ] - , [ infixR "??" (ExprBinary OpCoalesce) ] - , [ infixR "=" ExprAssign ] - ] - where - prefix name f = Prefix (f . wrapLoc <$ symbol name) - infixL name f = InfixL ((\l r -> f (wrapLoc l) (wrapLoc r)) <$ symbol name) - infixR name f = InfixR ((\l r -> f (wrapLoc l) (wrapLoc r)) <$ symbol name) - infixN name f = InfixN ((\l r -> f (wrapLoc l) (wrapLoc r)) <$ symbol name) - - wrapLoc :: Expr -> Located Expr - wrapLoc e = Located (SourcePos "" 0 0) e - --- | Parse a term (base expression) -termP :: Parser Expr -termP = choice - [ ExprLiteral <$> literalP - , ExprVariable <$> variableP - , try callP - , ExprConstant <$> qualifiedNameP - , parens (locNode <$> exprP) - ] - --- | Parse function call -callP :: Parser Expr -callP = do - name <- qualifiedNameP - args <- parens (commaSep argumentP) - pure $ ExprCall (Located (SourcePos "" 0 0) (ExprConstant name)) args - --- | Parse argument -argumentP :: Parser Argument -argumentP = do - name <- optional $ try (nameP <* symbol ":") - unpack <- option False (True <$ symbol "...") - value <- exprP - pure Argument - { argName = name - , argValue = value - , argUnpack = unpack - } - --- | Parse literal -literalP :: Parser Literal -literalP = choice - [ LitInt <$> lexeme L.decimal - , LitFloat <$> lexeme L.float - , LitString <$> stringP - , LitBool True <$ reserved "true" - , LitBool False <$ reserved "false" - , LitNull <$ reserved "null" - , LitArray <$> arrayP - ] - --- | Parse string literal -stringP :: Parser Text -stringP = lexeme $ choice - [ singleQuoted - , doubleQuoted - ] - where - singleQuoted = char '\'' *> (T.pack <$> manyTill L.charLiteral (char '\'')) - doubleQuoted = char '"' *> (T.pack <$> manyTill L.charLiteral (char '"')) - --- | Parse array literal -arrayP :: Parser [(Maybe (Located Expr), Located Expr)] -arrayP = brackets (commaSep arrayItemP) <|> (reserved "array" *> parens (commaSep arrayItemP)) - where - arrayItemP = do - key <- optional $ try (exprP <* symbol "=>") - value <- exprP - pure (key, value) - --- | Convert Megaparsec source position to our SourcePos -toSourcePos :: SourcePos -> Sanctify.AST.SourcePos -toSourcePos pos = Sanctify.AST.SourcePos - { posFile = sourceName pos - , posLine = unPos (sourceLine pos) - , posColumn = unPos (sourceColumn pos) - } diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Lexer.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Lexer.hs new file mode 100644 index 000000000..5b963a4f4 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Lexer.hs @@ -0,0 +1,4 @@ +-- SPDX-License-Identifier: MPL-2.0 +module Sanctify.Parser.Lexer where + +-- | Placeholder lexing utilities. diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Token.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Token.hs new file mode 100644 index 000000000..995b9468d --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Parser/Token.hs @@ -0,0 +1,4 @@ +-- SPDX-License-Identifier: MPL-2.0 +module Sanctify.Parser.Token where + +-- | Placeholder token utilities. diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Report.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Report.hs index 2c1dd00b6..f6d6ceb93 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Report.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Report.hs @@ -33,6 +33,7 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Time (UTCTime, getCurrentTime) +import Sanctify.AST (SourcePos (..)) import Sanctify.Analysis.Security import Sanctify.WordPress.Constraints import Sanctify.Config diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Ruleset.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Ruleset.hs new file mode 100644 index 000000000..689903563 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Ruleset.hs @@ -0,0 +1,445 @@ +-- | Ruleset management for sanctify-php +-- Provides configurable rule collections for static analysis +-- SPDX-License-Identifier: MPL-2.0 +module Sanctify.Ruleset + ( -- * Core types + Ruleset(..) + , RuleConfig(..) + , RuleId(..) + , RuleSeverity(..) + , RuleCategory(..) + + -- * Ruleset operations + , createRuleset + , mergeRulesets + , enableRule + , disableRule + , setRuleSeverity + , isRuleEnabled + , getRuleConfig + + -- * Predefined rulesets + , strictRuleset + , securityRuleset + , wordpressRuleset + , minimalRuleset + , defaultRuleset + + -- * Rule definitions + , allRules + , rulesByCategory + , getRuleInfo + , RuleInfo(..) + + -- * Serialization + , loadRuleset + , saveRuleset + , parseRulesetYaml + , getPredefinedRuleset + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified Data.Text.Encoding as TE +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Aeson (ToJSON, FromJSON, ToJSONKey, FromJSONKey, Value, encode, eitherDecodeStrict') +import qualified Data.ByteString.Lazy as BL +import GHC.Generics (Generic) +import Data.Maybe (fromMaybe) +import Control.Monad (forM) + +-- | Unique identifier for a rule +newtype RuleId = RuleId { unRuleId :: Text } + deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + deriving newtype (ToJSONKey, FromJSONKey) + +-- | Severity level for rules +data RuleSeverity + = SeverityOff -- ^ Rule is disabled + | SeverityInfo -- ^ Informational only + | SeverityWarning -- ^ Warning, may not be an issue + | SeverityError -- ^ Error, should be fixed + | SeverityCritical -- ^ Critical security issue + deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- | Categories of rules +data RuleCategory + = CategorySecurity -- ^ Security vulnerabilities + | CategoryDeadCode -- ^ Dead/unreachable code + | CategoryTypes -- ^ Type-related issues + | CategoryWordPress -- ^ WordPress-specific + | CategoryPerformance -- ^ Performance issues + | CategoryStyle -- ^ Code style + | CategoryMaintenance -- ^ Maintainability + deriving stock (Eq, Ord, Show, Generic, Enum, Bounded) + deriving anyclass (ToJSON, FromJSON, ToJSONKey, FromJSONKey) + +-- | Configuration for a single rule +data RuleConfig = RuleConfig + { rcEnabled :: Bool -- ^ Is the rule active? + , rcSeverity :: RuleSeverity -- ^ Override severity + , rcOptions :: Map Text Value -- ^ Rule-specific options + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- | Default rule configuration +defaultRuleConfig :: RuleConfig +defaultRuleConfig = RuleConfig + { rcEnabled = True + , rcSeverity = SeverityWarning + , rcOptions = Map.empty + } + +-- | Information about a rule +data RuleInfo = RuleInfo + { riId :: RuleId + , riName :: Text + , riDescription :: Text + , riCategory :: RuleCategory + , riDefault :: RuleSeverity + , riAutoFixable :: Bool + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- | A complete ruleset +data Ruleset = Ruleset + { rsName :: Text -- ^ Ruleset name + , rsDescription :: Text -- ^ Description + , rsExtends :: Maybe Text -- ^ Parent ruleset name + , rsRules :: Map RuleId RuleConfig -- ^ Rule configurations + , rsCategories :: Map RuleCategory Bool -- ^ Enable/disable categories + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- | All available rules in the system +allRules :: [RuleInfo] +allRules = + -- Security rules + [ RuleInfo (RuleId "SEC001") "sql-injection" + "Detect potential SQL injection vulnerabilities" + CategorySecurity SeverityCritical True + , RuleInfo (RuleId "SEC002") "xss" + "Detect potential cross-site scripting (XSS) vulnerabilities" + CategorySecurity SeverityCritical True + , RuleInfo (RuleId "SEC003") "command-injection" + "Detect potential command injection via shell execution" + CategorySecurity SeverityCritical False + , RuleInfo (RuleId "SEC004") "path-traversal" + "Detect potential path traversal in file operations" + CategorySecurity SeverityError True + , RuleInfo (RuleId "SEC005") "unsafe-deserialization" + "Detect unsafe use of unserialize()" + CategorySecurity SeverityError True + , RuleInfo (RuleId "SEC006") "weak-crypto" + "Detect use of weak cryptographic functions (md5, sha1)" + CategorySecurity SeverityWarning True + , RuleInfo (RuleId "SEC007") "hardcoded-secrets" + "Detect hardcoded passwords, API keys, and secrets" + CategorySecurity SeverityError False + , RuleInfo (RuleId "SEC008") "insecure-random" + "Detect use of insecure random number generators" + CategorySecurity SeverityWarning True + , RuleInfo (RuleId "SEC009") "eval-usage" + "Detect use of eval() and similar dynamic code execution" + CategorySecurity SeverityCritical False + , RuleInfo (RuleId "SEC010") "missing-strict-types" + "Detect missing declare(strict_types=1)" + CategorySecurity SeverityInfo True + + -- Dead code rules + , RuleInfo (RuleId "DEAD001") "unused-variable" + "Detect variables that are assigned but never used" + CategoryDeadCode SeverityWarning False + , RuleInfo (RuleId "DEAD002") "unreachable-code" + "Detect code after return, throw, break, or continue" + CategoryDeadCode SeverityWarning False + , RuleInfo (RuleId "DEAD003") "unused-parameter" + "Detect function parameters that are never used" + CategoryDeadCode SeverityInfo False + , RuleInfo (RuleId "DEAD004") "unused-import" + "Detect use statements that are never referenced" + CategoryDeadCode SeverityWarning False + + -- Type rules + , RuleInfo (RuleId "TYPE001") "missing-param-type" + "Detect function parameters without type hints" + CategoryTypes SeverityInfo True + , RuleInfo (RuleId "TYPE002") "missing-return-type" + "Detect functions without return type declarations" + CategoryTypes SeverityInfo True + , RuleInfo (RuleId "TYPE003") "missing-property-type" + "Detect class properties without type declarations" + CategoryTypes SeverityInfo True + , RuleInfo (RuleId "TYPE004") "type-coercion-risk" + "Detect potential type coercion issues" + CategoryTypes SeverityWarning False + + -- WordPress rules + , RuleInfo (RuleId "WP001") "missing-escaping" + "Detect unescaped output in WordPress context" + CategoryWordPress SeverityError True + , RuleInfo (RuleId "WP002") "missing-sanitization" + "Detect unsanitized input in WordPress context" + CategoryWordPress SeverityError True + , RuleInfo (RuleId "WP003") "missing-nonce" + "Detect form handlers without nonce verification" + CategoryWordPress SeverityError True + , RuleInfo (RuleId "WP004") "missing-capability-check" + "Detect privileged operations without capability checks" + CategoryWordPress SeverityError False + , RuleInfo (RuleId "WP005") "direct-db-query" + "Detect direct database queries without prepare()" + CategoryWordPress SeverityError True + , RuleInfo (RuleId "WP006") "missing-text-domain" + "Detect translatable strings without text domain" + CategoryWordPress SeverityWarning True + , RuleInfo (RuleId "WP007") "unprefixed-function" + "Detect global functions without plugin prefix" + CategoryWordPress SeverityWarning False + , RuleInfo (RuleId "WP008") "deprecated-function" + "Detect use of deprecated WordPress functions" + CategoryWordPress SeverityWarning True + + -- Performance rules + , RuleInfo (RuleId "PERF001") "n-plus-one-query" + "Detect potential N+1 query patterns" + CategoryPerformance SeverityWarning False + , RuleInfo (RuleId "PERF002") "large-array-in-loop" + "Detect large array operations inside loops" + CategoryPerformance SeverityInfo False + + -- Style rules + , RuleInfo (RuleId "STYLE001") "mixed-tabs-spaces" + "Detect mixed indentation styles" + CategoryStyle SeverityInfo False + , RuleInfo (RuleId "STYLE002") "long-function" + "Detect functions exceeding line limit" + CategoryStyle SeverityInfo False + + -- Maintenance rules + , RuleInfo (RuleId "MAINT001") "todo-comment" + "Detect TODO/FIXME comments" + CategoryMaintenance SeverityInfo False + , RuleInfo (RuleId "MAINT002") "complex-condition" + "Detect overly complex conditional expressions" + CategoryMaintenance SeverityInfo False + ] + +-- | Get rules by category +rulesByCategory :: RuleCategory -> [RuleInfo] +rulesByCategory cat = filter ((== cat) . riCategory) allRules + +-- | Get information about a specific rule +getRuleInfo :: RuleId -> Maybe RuleInfo +getRuleInfo rid = lookup rid [(riId r, r) | r <- allRules] + +-- | Create a new ruleset from a list of enabled rules +createRuleset :: Text -> Text -> [RuleId] -> Ruleset +createRuleset name desc ruleIds = Ruleset + { rsName = name + , rsDescription = desc + , rsExtends = Nothing + , rsRules = Map.fromList + [ (rid, defaultRuleConfig { rcEnabled = rid `elem` ruleIds }) + | RuleInfo{riId = rid} <- allRules + ] + , rsCategories = Map.fromList [(cat, True) | cat <- [minBound..maxBound]] + } + +-- | Merge two rulesets (second overrides first) +mergeRulesets :: Ruleset -> Ruleset -> Ruleset +mergeRulesets base override = Ruleset + { rsName = rsName override + , rsDescription = rsDescription override + , rsExtends = rsExtends override + , rsRules = Map.unionWith mergeRuleConfig (rsRules base) (rsRules override) + , rsCategories = Map.union (rsCategories override) (rsCategories base) + } + where + mergeRuleConfig _ new = new + +-- | Enable a specific rule +enableRule :: RuleId -> Ruleset -> Ruleset +enableRule rid rs = rs + { rsRules = Map.alter enable rid (rsRules rs) } + where + enable Nothing = Just defaultRuleConfig + enable (Just rc) = Just rc { rcEnabled = True } + +-- | Disable a specific rule +disableRule :: RuleId -> Ruleset -> Ruleset +disableRule rid rs = rs + { rsRules = Map.alter disable rid (rsRules rs) } + where + disable Nothing = Just defaultRuleConfig { rcEnabled = False } + disable (Just rc) = Just rc { rcEnabled = False } + +-- | Set severity for a specific rule +setRuleSeverity :: RuleId -> RuleSeverity -> Ruleset -> Ruleset +setRuleSeverity rid sev rs = rs + { rsRules = Map.alter setSev rid (rsRules rs) } + where + setSev Nothing = Just defaultRuleConfig { rcSeverity = sev } + setSev (Just rc) = Just rc { rcSeverity = sev } + +-- | Check if a rule is enabled +isRuleEnabled :: RuleId -> Ruleset -> Bool +isRuleEnabled rid rs = + case Map.lookup rid (rsRules rs) of + Nothing -> True -- Default enabled + Just rc -> rcEnabled rc && categoryEnabled + where + categoryEnabled = case getRuleInfo rid of + Nothing -> True + Just info -> fromMaybe True $ Map.lookup (riCategory info) (rsCategories rs) + +-- | Get configuration for a rule +getRuleConfig :: RuleId -> Ruleset -> RuleConfig +getRuleConfig rid rs = fromMaybe defaultRuleConfig $ Map.lookup rid (rsRules rs) + +-- ============================================================================ +-- Predefined Rulesets +-- ============================================================================ + +-- | Strict ruleset - all rules enabled with high severity +strictRuleset :: Ruleset +strictRuleset = Ruleset + { rsName = "strict" + , rsDescription = "All rules enabled with elevated severity" + , rsExtends = Nothing + , rsRules = Map.fromList + [ (riId info, RuleConfig True (elevate (riDefault info)) Map.empty) + | info <- allRules + ] + , rsCategories = Map.fromList [(cat, True) | cat <- [minBound..maxBound]] + } + where + elevate SeverityInfo = SeverityWarning + elevate SeverityWarning = SeverityError + elevate other = other + +-- | Security-focused ruleset +securityRuleset :: Ruleset +securityRuleset = Ruleset + { rsName = "security" + , rsDescription = "Security-focused rules only" + , rsExtends = Nothing + , rsRules = Map.fromList + [ (riId info, RuleConfig (riCategory info == CategorySecurity) (riDefault info) Map.empty) + | info <- allRules + ] + , rsCategories = Map.fromList + [ (CategorySecurity, True) + , (CategoryDeadCode, False) + , (CategoryTypes, False) + , (CategoryWordPress, False) + , (CategoryPerformance, False) + , (CategoryStyle, False) + , (CategoryMaintenance, False) + ] + } + +-- | WordPress-specific ruleset +wordpressRuleset :: Ruleset +wordpressRuleset = Ruleset + { rsName = "wordpress" + , rsDescription = "WordPress plugin/theme development rules" + , rsExtends = Nothing + , rsRules = Map.fromList + [ (riId info, RuleConfig enabled (riDefault info) Map.empty) + | info <- allRules + , let enabled = riCategory info `elem` + [CategorySecurity, CategoryWordPress, CategoryDeadCode] + ] + , rsCategories = Map.fromList + [ (CategorySecurity, True) + , (CategoryDeadCode, True) + , (CategoryTypes, True) + , (CategoryWordPress, True) + , (CategoryPerformance, True) + , (CategoryStyle, False) + , (CategoryMaintenance, False) + ] + } + +-- | Minimal ruleset - only critical security issues +minimalRuleset :: Ruleset +minimalRuleset = Ruleset + { rsName = "minimal" + , rsDescription = "Only critical security issues" + , rsExtends = Nothing + , rsRules = Map.fromList + [ (riId info, RuleConfig (riDefault info >= SeverityError) (riDefault info) Map.empty) + | info <- allRules + ] + , rsCategories = Map.fromList + [ (CategorySecurity, True) + , (CategoryDeadCode, False) + , (CategoryTypes, False) + , (CategoryWordPress, False) + , (CategoryPerformance, False) + , (CategoryStyle, False) + , (CategoryMaintenance, False) + ] + } + +-- | Default ruleset - balanced settings +defaultRuleset :: Ruleset +defaultRuleset = Ruleset + { rsName = "default" + , rsDescription = "Balanced default settings" + , rsExtends = Nothing + , rsRules = Map.fromList + [ (riId info, RuleConfig True (riDefault info) Map.empty) + | info <- allRules + ] + , rsCategories = Map.fromList + [ (CategorySecurity, True) + , (CategoryDeadCode, True) + , (CategoryTypes, True) + , (CategoryWordPress, False) -- Auto-detected + , (CategoryPerformance, False) + , (CategoryStyle, False) + , (CategoryMaintenance, False) + ] + } + +-- ============================================================================ +-- Serialization +-- ============================================================================ + +-- | Load a ruleset from a JSON/YAML file +loadRuleset :: FilePath -> IO (Either String Ruleset) +loadRuleset path = do + content <- TIO.readFile path + pure $ parseRulesetYaml content + +-- | Save a ruleset to a file +saveRuleset :: FilePath -> Ruleset -> IO () +saveRuleset path rs = BL.writeFile path (encode rs) + +-- | Parse a ruleset from YAML/JSON text +parseRulesetYaml :: Text -> Either String Ruleset +parseRulesetYaml content = + case eitherDecodeStrict' (TE.encodeUtf8 content) of + Left err -> Left $ "Failed to parse ruleset: " ++ err + Right rs -> Right rs + +-- | Get a predefined ruleset by name +getPredefinedRuleset :: Text -> Maybe Ruleset +getPredefinedRuleset name = case T.toLower name of + "strict" -> Just strictRuleset + "security" -> Just securityRuleset + "wordpress" -> Just wordpressRuleset + "minimal" -> Just minimalRuleset + "default" -> Just defaultRuleset + _ -> Nothing diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Sanitize.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Sanitize.hs index 9fac8ee67..7bc29afcc 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Sanitize.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Sanitize.hs @@ -19,12 +19,18 @@ module Sanctify.Transform.Sanitize , sanitizeSuperglobalAccess , escapeEchoStatement , addExitAfterRedirect + , transformSanitizeOutput + , transformSanitizeInput + , transformSQLPrepare + , transformRedirectSafety + , transformModernizeCrypto ) where import Data.Text (Text) import qualified Data.Text as T import Sanctify.AST +import Sanctify.WordPress.Constraints (isWpdbObject) -- | Context for output escaping data EscapeContext @@ -207,3 +213,128 @@ addExitAfterRedirect = concatMap processStmt ExprCall (Located pos $ ExprConstant $ QualifiedName [Name "exit"] False) [] + +-- | Transform: escape outputs across the file +transformSanitizeOutput :: PhpFile -> PhpFile +transformSanitizeOutput file = file { phpStatements = map escapeStmt (phpStatements file) } + where + escapeStmt stmt@(Located pos (StmtEcho exprs)) = + Located pos $ StmtEcho $ map (wrapWithEscape $ detectEscapeContext stmt) exprs + escapeStmt stmt = stmt + +-- | Transform: sanitize superglobal inputs everywhere +transformSanitizeInput :: PhpFile -> PhpFile +transformSanitizeInput file = file { phpStatements = map (mapStatement sanitizeExpr) (phpStatements file) } + where + sanitizeExpr = mapExpr sanitizeSuperglobalAccess + +-- | Transform: wrap unsafe $wpdb queries with prepare() +transformSQLPrepare :: PhpFile -> PhpFile +transformSQLPrepare file = file { phpStatements = map (mapStatement prepareQueries) (phpStatements file) } + where + prepareQueries = mapExpr prepareNode + + prepareNode loc@(Located pos expr@(ExprMethodCall obj method args)) + | isWpdbObject obj + , let name = unName method + , name `elem` ["query", "get_results", "get_row", "get_col", "get_var"] + , not (null args) + , let firstArg@(Argument n argVal unpack) = head args + , Just (query, params) <- convertToParameterizedQuery argVal + = Located pos $ ExprMethodCall obj method $ Argument n (wrapWithPrepare query params) unpack : tail args + prepareNode loc = loc + +-- | Transform: ensure redirects end with exit() +transformRedirectSafety :: PhpFile -> PhpFile +transformRedirectSafety file = file { phpStatements = addExitAfterRedirect (phpStatements file) } + +-- | Transform: modernize weak crypto helpers +transformModernizeCrypto :: PhpFile -> PhpFile +transformModernizeCrypto file = file { phpStatements = map (mapStatement modernizeExpr) (phpStatements file) } + where + modernizeExpr = mapExpr modernizeNode + + modernizeNode loc@(Located pos expr@(ExprCall callee args)) = + case functionName callee of + Just fn | fn == "rand" -> Located pos $ ExprCall (makeConst pos "random_int") (map updateArg args) + | fn == "md5" -> Located pos $ ExprCall (makeConst pos "hash") (Argument Nothing (Located pos $ ExprLiteral $ LitString "sha3-256") False : map updateArg args) + | fn == "sha1" -> Located pos $ ExprCall (makeConst pos "sodium_crypto_generichash") (map updateArg args) + _ -> loc + + modernizeNode loc = loc + + updateArg (Argument name value unpack) = Argument name (modernizeExpr value) unpack + + makeConst p name = Located p $ ExprConstant $ QualifiedName [Name name] False + + functionName (Located _ (ExprConstant (QualifiedName parts _))) = Just $ unName $ last parts + functionName _ = Nothing + +mapArgument :: (Located Expr -> Located Expr) -> Argument -> Argument +mapArgument f (Argument name value unpack) = Argument name (f value) unpack + +mapExpr :: (Located Expr -> Located Expr) -> Located Expr -> Located Expr +mapExpr f (Located pos expr) = f $ Located pos (case expr of + ExprBinary op l r -> ExprBinary op (mapExpr f l) (mapExpr f r) + ExprUnary op e -> ExprUnary op (mapExpr f e) + ExprAssign e1 e2 -> ExprAssign (mapExpr f e1) (mapExpr f e2) + ExprAssignOp op e1 e2 -> ExprAssignOp op (mapExpr f e1) (mapExpr f e2) + ExprTernary c t e -> ExprTernary (mapExpr f c) (fmap (mapExpr f) t) (mapExpr f e) + ExprCall callee args -> ExprCall (mapExpr f callee) (map (mapArgument f) args) + ExprMethodCall obj name args -> ExprMethodCall (mapExpr f obj) name (map (mapArgument f) args) + ExprStaticCall qn name args -> ExprStaticCall qn name (map (mapArgument f) args) + ExprNullsafeMethodCall obj name args -> ExprNullsafeMethodCall (mapExpr f obj) name (map (mapArgument f) args) + ExprPropertyAccess obj name -> ExprPropertyAccess (mapExpr f obj) name + ExprNullsafePropertyAccess obj name -> ExprNullsafePropertyAccess (mapExpr f obj) name + ExprStaticPropertyAccess qn name -> ExprStaticPropertyAccess qn name + ExprArrayAccess base idx -> ExprArrayAccess (mapExpr f base) (fmap (mapExpr f) idx) + ExprNew qn args -> ExprNew qn (map (mapArgument f) args) + ExprClosure{closureStatic=st, closureParams=ps, closureUses=us, closureReturn=ret, closureBody=body} -> + ExprClosure st ps us ret (map (mapStatement f) body) + ExprArrowFunction{arrowParams=params, arrowReturn=ret, arrowExpr=expr} -> + ExprArrowFunction params ret (mapExpr f expr) + ExprCast ty e -> ExprCast ty (mapExpr f e) + ExprIsset exprs -> ExprIsset (map (mapExpr f) exprs) + ExprEmpty e -> ExprEmpty (mapExpr f e) + ExprEval e -> ExprEval (mapExpr f e) + ExprInclude ty e -> ExprInclude ty (mapExpr f e) + ExprYield m1 m2 -> ExprYield (fmap (mapExpr f) m1) (fmap (mapExpr f) m2) + ExprYieldFrom e -> ExprYieldFrom (mapExpr f e) + ExprThrow e -> ExprThrow (mapExpr f e) + ExprClassConstAccess qn name -> ExprClassConstAccess qn name + ExprConstant qn -> ExprConstant qn + ExprShellExec t -> ExprShellExec t + ExprHeredoc t -> ExprHeredoc t + ExprList items -> ExprList (map (fmap (mapExpr f)) items) + _ -> expr) + +mapStatement :: (Located Expr -> Located Expr) -> Located Statement -> Located Statement +mapStatement f (Located pos stmt) = Located pos (case stmt of + StmtExpr expr -> StmtExpr (f expr) + StmtDecl decl -> StmtDecl decl + StmtIf cond thenStmts elseStmts -> StmtIf (f cond) (map (mapStatement f) thenStmts) (fmap (map (mapStatement f)) elseStmts) + StmtWhile cond body -> StmtWhile (f cond) (map (mapStatement f) body) + StmtFor mInit mCond mUpdate body -> StmtFor (fmap f mInit) (fmap f mCond) (fmap f mUpdate) (map (mapStatement f) body) + StmtForeach expr var forKey body -> StmtForeach (f expr) var forKey (map (mapStatement f) body) + StmtSwitch expr cases -> StmtSwitch (f expr) (map (mapCase f) cases) + StmtMatch expr arms -> StmtMatch (f expr) (map (mapArm f) arms) + StmtTry tryBody catches finally -> StmtTry (map (mapStatement f) tryBody) (map (mapCatch f) catches) (fmap (map (mapStatement f)) finally) + StmtReturn mExpr -> StmtReturn (fmap f mExpr) + StmtThrow expr -> StmtThrow (f expr) + StmtBreak n -> StmtBreak n + StmtContinue n -> StmtContinue n + StmtEcho exprs -> StmtEcho (map f exprs) + StmtGlobal vars -> StmtGlobal vars + StmtStatic pairs -> StmtStatic (map (\(var, mexpr) -> (var, fmap f mexpr)) pairs) + StmtUnset exprs -> StmtUnset (map f exprs) + StmtDeclare decls body -> StmtDeclare decls (map (mapStatement f) body) + StmtNoop -> StmtNoop) + +mapCase :: (Located Expr -> Located Expr) -> SwitchCase -> SwitchCase +mapCase f (SwitchCase cond body) = SwitchCase (fmap (mapExpr f) cond) (map (mapStatement f) body) + +mapArm :: (Located Expr -> Located Expr) -> MatchArm -> MatchArm +mapArm f (MatchArm cond result) = MatchArm (map (mapExpr f) cond) (mapExpr f result) + +mapCatch :: (Located Expr -> Located Expr) -> CatchClause -> CatchClause +mapCatch f (CatchClause types var body) = CatchClause types var (map (mapStatement f) body) diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Strict.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Strict.hs new file mode 100644 index 000000000..705fb3d7b --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/Strict.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE StrictData #-} +-- SPDX-License-Identifier: MPL-2.0 +module Sanctify.Transform.Strict + ( transformStrict + , transformWordPressSecurity + ) where + +import Sanctify.AST +import Sanctify.Transform.StrictTypes + +-- | Add strict types to a PHP file. +transformStrict :: PhpFile -> PhpFile +transformStrict = addStrictTypes + +-- | Apply WordPress-specific hardening (ABSPATH + admin checks). +transformWordPressSecurity :: PhpFile -> PhpFile +transformWordPressSecurity file = + addAbspathCheck file diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/TypeHints.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/TypeHints.hs index b22a74cfd..6107ebcca 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/TypeHints.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/Transform/TypeHints.hs @@ -13,6 +13,7 @@ module Sanctify.Transform.TypeHints -- * Full file transformation , addAllTypeHints + , transformAddTypeHints ) where import Data.Text (Text) @@ -20,7 +21,7 @@ import qualified Data.Text as T import Data.Maybe (fromMaybe, mapMaybe) import Sanctify.AST -import Sanctify.Analysis.Types +import Sanctify.Analysis.Types (TypeContext, emptyTypeContext, InferredType) -- | Add type hints to function parameters based on defaults and usage addParameterTypeHints :: TypeContext -> Declaration -> Declaration @@ -256,3 +257,11 @@ addAllTypeHints ctx file = file addMethodReturnHint c meth@MemberMethod{methReturn = Nothing, methBody = Just body} = meth { methReturn = inferReturnType c body } addMethodReturnHint _ meth = meth + +-- | Run the type hint inference pipeline on a PHP file +transformAddTypeHints :: PhpFile -> PhpFile +transformAddTypeHints = addAllTypeHints emptyTypeContext + +-- | Apply all type hint transformations with a fresh context +transformAddTypeHints :: PhpFile -> PhpFile +transformAddTypeHints = addAllTypeHints emptyTypeContext diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Constraints.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Constraints.hs index 002a4ae0e..b84b31d94 100644 --- a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Constraints.hs +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Constraints.hs @@ -28,6 +28,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Control.Monad (unless, when) import Control.Monad.Writer import GHC.Generics (Generic) import Data.Aeson (ToJSON) diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Security.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Security.hs new file mode 100644 index 000000000..92162ce4a --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/src/Sanctify/WordPress/Security.hs @@ -0,0 +1,520 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | WordPress-Specific Security Deep Analysis +-- SPDX-License-Identifier: MPL-2.0 +module Sanctify.WordPress.Security + ( -- * WordPress security analysis + analyzeWordPressSecurity + , WordPressIssue(..) + , WordPressIssueType(..) + + -- * Specific WordPress checks + , checkNonceVerification + , checkCapabilityChecks + , checkDatabaseQueries + , checkHookPriorities + , checkAjaxSecurity + , checkRestApiSecurity + , checkFileUploadSecurity + , checkUserMetaSecurity + , checkTransientSecurity + , checkCronSecurity + , checkShortcodeSecurity + , checkWidgetSecurity + , checkGutenbergBlockSecurity + , checkI18nSecurity + , checkEscapingContext + , checkCustomTableSecurity + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Control.Monad (unless, when) +import Control.Monad.Writer +import GHC.Generics (Generic) +import Data.Aeson (ToJSON) +import Data.Maybe (catMaybes) + +import Sanctify.AST +import Sanctify.Analysis.Security (Severity(..)) + +-- | WordPress-specific issue types +data WordPressIssueType + = MissingNonce + | MissingCapability + | InsecureDirectoryQuery + | UnsafeMeta + | InsecureAjax + | InsecureRestApi + | InsecureFileUpload + | InsecureTransient + | InsecureCron + | ShortcodeXSS + | WidgetXSS + | BlockXSS + | MissingTextDomain + | ImproperEscaping + | HookPriorityConflict + | CustomTableInjection + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON) + +-- | WordPress security issue +data WordPressIssue = WordPressIssue + { wpType :: WordPressIssueType + , wpSeverity :: Severity + , wpLocation :: SourcePos + , wpDescription :: Text + , wpRemedy :: Text + , wpCode :: Maybe Text + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON) + +type WordPressM = Writer [WordPressIssue] + +-- | Analyze WordPress-specific security issues +analyzeWordPressSecurity :: PhpFile -> [WordPressIssue] +analyzeWordPressSecurity file = execWriter $ do + mapM_ analyzeStatement (phpStatements file) + checkNonceUsage file + checkCapabilityUsage file + +-- | Analyze a statement for WordPress issues +analyzeStatement :: Located Statement -> WordPressM () +analyzeStatement (Located pos stmt) = case stmt of + StmtExpr expr -> analyzeExpr pos expr + StmtIf cond thenStmts elseStmts -> do + analyzeExpr pos cond + mapM_ analyzeStatement thenStmts + maybe (pure ()) (mapM_ analyzeStatement) elseStmts + StmtDecl decl -> analyzeDeclaration pos decl + _ -> pure () + +-- | Analyze a declaration +analyzeDeclaration :: SourcePos -> Declaration -> WordPressM () +analyzeDeclaration pos decl = case decl of + DeclFunction{fnBody = body} -> mapM_ analyzeStatement body + DeclClass{clsMembers = members} -> mapM_ (analyzeClassMember pos) members + _ -> pure () + +-- | Analyze class members +analyzeClassMember :: SourcePos -> ClassMember -> WordPressM () +analyzeClassMember pos member = case member of + MemberMethod{methBody = Just body} -> mapM_ analyzeStatement body + _ -> pure () + +-- | Analyze an expression for WordPress issues +analyzeExpr :: SourcePos -> Located Expr -> WordPressM () +analyzeExpr pos (Located _ expr) = case expr of + ExprCall callee args -> checkWordPressFunction pos callee args + ExprMethodCall obj name args -> checkWordPressMethod pos obj name args + _ -> pure () + +-- | Check WordPress function calls +checkWordPressFunction :: SourcePos -> Located Expr -> [Argument] -> WordPressM () +checkWordPressFunction pos (Located _ (ExprConstant qn)) args = do + let fname = T.toLower $ unName $ last $ qnParts qn + + -- Check database queries + when (fname `elem` wpdbFunctions && not (isWpdbPrepare args)) $ + tell [WordPressIssue CustomTableInjection Critical pos + ("Custom table query without preparation: " <> fname) + "Use $wpdb->prepare() for all queries with variables" + (Just fname)] + + -- Check AJAX actions + when (fname `elem` ["add_action"] && isAjaxAction args && not (hasNonceInContext fname)) $ + tell [WordPressIssue InsecureAjax High pos + "AJAX action without nonce verification" + "Add check_ajax_referer() at the beginning of the handler" + Nothing] + + -- Check REST API registration + when (fname == "register_rest_route" && not (hasPermissionCallback args)) $ + tell [WordPressIssue InsecureRestApi High pos + "REST API route without permission_callback" + "Add 'permission_callback' to check user capabilities" + (Just "register_rest_route")] + + -- Check file uploads + when (fname == "move_uploaded_file" && not (hasFileValidation args)) $ + tell [WordPressIssue InsecureFileUpload Critical pos + "File upload without validation" + "Validate file type, size, and use wp_handle_upload()" + (Just "move_uploaded_file")] + + -- Check transients + when (fname `elem` ["set_transient", "set_site_transient"] && hasUserInput args) $ + tell [WordPressIssue InsecureTransient Medium pos + "Transient set with unsanitized user input" + "Sanitize data before storing in transients" + (Just fname)] + + -- Check cron + when (fname == "wp_schedule_single_event" && hasUserInput args) $ + tell [WordPressIssue InsecureCron High pos + "Cron event scheduled with user-controlled data" + "Validate cron arguments and sanitize callback parameters" + (Just "wp_schedule_single_event")] + + -- Check user meta + when (fname `elem` ["update_user_meta", "add_user_meta"] && not (hasMetaKeyValidation args)) $ + tell [WordPressIssue UnsafeMeta Medium pos + ("User meta update without key validation: " <> fname) + "Validate meta keys against whitelist" + (Just fname)] + +checkWordPressFunction _ _ _ = pure () + +-- | Check WordPress method calls +checkWordPressMethod :: SourcePos -> Located Expr -> Name -> [Argument] -> WordPressM () +checkWordPressMethod pos obj (Name method) args = do + let lmethod = T.toLower method + + -- Check $wpdb methods + when (isWpdbObject obj) $ do + when (lmethod `elem` ["query", "get_results", "get_row", "get_col", "get_var"] && + not (null args) && hasVariableInQuery (head args)) $ + tell [WordPressIssue InsecureDirectoryQuery Critical pos + ("$wpdb->" <> method <> " with variable: use prepare()") + "Always use $wpdb->prepare() for queries with variables" + (Just $ "$wpdb->" <> method)] + +-- | Check for nonce verification in file +checkNonceUsage :: PhpFile -> WordPressM () +checkNonceUsage file = + when (hasFormProcessing file && not (hasNonceVerification file)) $ + tell [WordPressIssue MissingNonce High (mkPos file) + "Form processing without nonce verification" + "Add wp_verify_nonce() or check_admin_referer()" + Nothing] + +-- | Check for capability checks in admin pages +checkCapabilityUsage :: PhpFile -> WordPressM () +checkCapabilityUsage file = + when (hasAdminPageRegistration file && not (hasCapabilityCheck file)) $ + tell [WordPressIssue MissingCapability High (mkPos file) + "Admin page without capability check" + "Add current_user_can() check" + Nothing] + +-- | Check nonce verification specifically +checkNonceVerification :: Located Expr -> Maybe WordPressIssue +checkNonceVerification (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) _ + | fname `elem` nonceVerifyFunctions -> Nothing -- Good! + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> Just $ WordPressIssue MissingNonce High pos + "Missing nonce verification in form handler" + "Add wp_verify_nonce(), check_admin_referer(), or check_ajax_referer()" + Nothing + where + nonceVerifyFunctions = ["wp_verify_nonce", "check_admin_referer", "check_ajax_referer"] + +-- | Check capability checks +checkCapabilityChecks :: Located Expr -> Maybe WordPressIssue +checkCapabilityChecks (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) _ + | fname `elem` capabilityFunctions -> Nothing -- Good! + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> Just $ WordPressIssue MissingCapability High pos + "Missing capability check before sensitive operation" + "Add current_user_can(), user_can(), or is_admin() check" + Nothing + where + capabilityFunctions = ["current_user_can", "user_can", "is_admin", "is_super_admin"] + +-- | Check $wpdb queries for SQL injection +checkDatabaseQueries :: Located Expr -> [WordPressIssue] +checkDatabaseQueries (Located pos expr) = case expr of + ExprMethodCall obj (Name method) args + | isWpdbObject obj + , T.toLower method `elem` ["query", "get_results", "get_row", "get_col", "get_var"] + , not (null args) + , hasVariableInQuery (head args) -> + [WordPressIssue InsecureDirectoryQuery Critical pos + ("Unsafe $wpdb->" <> method <> ": variable in query") + "Use $wpdb->prepare() with placeholders (%s, %d, %f)" + (Just $ "$wpdb->" <> method)] + _ -> [] + +-- | Check hook priorities for conflicts +checkHookPriorities :: PhpFile -> [WordPressIssue] +checkHookPriorities file = execWriter $ mapM_ checkStmt (phpStatements file) + where + checkStmt :: Located Statement -> Writer [WordPressIssue] () + checkStmt (Located pos stmt) = case stmt of + StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) args)) + | fname `elem` ["add_action", "add_filter"] + , length args >= 3 -> + case args !! 2 of + Argument _ (Located _ (ExprLiteral (LitInt prio))) _ + | prio < 0 || prio > 1000 -> + tell [WordPressIssue HookPriorityConflict Medium pos + ("Unusual hook priority: " <> T.pack (show prio)) + "Use standard priorities (1-20) unless necessary" + (Just $ fname <> " with priority " <> T.pack (show prio))] + _ -> pure () + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> pure () + +-- | Check AJAX handler security +checkAjaxSecurity :: Located Expr -> [WordPressIssue] +checkAjaxSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname == "add_action" + , not (null args) + , isAjaxAction args -> + [WordPressIssue InsecureAjax High pos + "AJAX handler may lack nonce verification" + "Add check_ajax_referer() at handler start" + (Just "add_action('wp_ajax_...')")] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check REST API endpoint security +checkRestApiSecurity :: Located Expr -> [WordPressIssue] +checkRestApiSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname == "register_rest_route" + , not (hasPermissionCallback args) -> + [WordPressIssue InsecureRestApi Critical pos + "REST API route without permission_callback" + "Add 'permission_callback' to validate user permissions" + (Just "register_rest_route")] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check file upload security +checkFileUploadSecurity :: Located Expr -> [WordPressIssue] +checkFileUploadSecurity (Located pos expr) = case expr of + ExprVariable (Variable "_FILES") -> + [WordPressIssue InsecureFileUpload High pos + "Direct $_FILES access without validation" + "Use wp_handle_upload() or wp_handle_sideload() with validation" + (Just "$_FILES")] + + ExprCall (Located _ (ExprConstant qn)) _ + | fname == "move_uploaded_file" -> + [WordPressIssue InsecureFileUpload High pos + "Direct move_uploaded_file() usage" + "Use WordPress upload functions: wp_handle_upload()" + (Just "move_uploaded_file")] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check user meta security +checkUserMetaSecurity :: Located Expr -> [WordPressIssue] +checkUserMetaSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["update_user_meta", "add_user_meta", "delete_user_meta"] + , hasUserInput args -> + [WordPressIssue UnsafeMeta High pos + ("User meta operation with unsanitized input: " <> fname) + "Sanitize meta key and value, validate against whitelist" + (Just fname)] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check transient security +checkTransientSecurity :: Located Expr -> [WordPressIssue] +checkTransientSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["set_transient", "set_site_transient"] + , hasUserInput args -> + [WordPressIssue InsecureTransient Medium pos + "Transient stored with unsanitized user input" + "Sanitize data before storing, consider expiration time" + (Just fname)] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check cron security +checkCronSecurity :: Located Expr -> [WordPressIssue] +checkCronSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` ["wp_schedule_single_event", "wp_schedule_event"] + , hasUserInput args -> + [WordPressIssue InsecureCron High pos + "Cron event with user-controlled parameters" + "Validate and sanitize cron arguments" + (Just fname)] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check shortcode security +checkShortcodeSecurity :: Located Expr -> [WordPressIssue] +checkShortcodeSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) _ + | fname == "add_shortcode" -> + [WordPressIssue ShortcodeXSS Medium pos + "Shortcode registration - verify output escaping" + "Ensure shortcode output is escaped with esc_html() or esc_attr()" + (Just "add_shortcode")] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check widget security +checkWidgetSecurity :: Located Declaration -> [WordPressIssue] +checkWidgetSecurity (Located pos decl) = case decl of + DeclClass{clsName = Name className} + | "Widget" `T.isInfixOf` className -> + [WordPressIssue WidgetXSS Medium pos + "Widget class - verify form() and update() escape output" + "Escape all widget output and sanitize widget settings" + (Just className)] + _ -> [] + +-- | Check Gutenberg block security +checkGutenbergBlockSecurity :: Located Expr -> [WordPressIssue] +checkGutenbergBlockSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) _ + | fname == "register_block_type" -> + [WordPressIssue BlockXSS Medium pos + "Gutenberg block - verify render_callback escaping" + "Escape block output, validate attributes, sanitize user input" + (Just "register_block_type")] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check i18n security +checkI18nSecurity :: Located Expr -> [WordPressIssue] +checkI18nSecurity (Located pos expr) = case expr of + ExprCall (Located _ (ExprConstant qn)) args + | fname `elem` i18nFunctions + , not (hasTextDomain args) -> + [WordPressIssue MissingTextDomain Low pos + ("Missing text domain in " <> fname) + "Add text domain for proper translation" + (Just fname)] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + where + i18nFunctions = ["__", "_e", "_x", "_ex", "_n", "_nx", "esc_html__", "esc_html_e", + "esc_attr__", "esc_attr_e"] + +-- | Check escaping context +checkEscapingContext :: Located Expr -> [WordPressIssue] +checkEscapingContext (Located pos expr) = case expr of + -- esc_html() in URL context + ExprCall (Located _ (ExprConstant qn)) _ + | fname == "esc_html" && isInUrlContext pos -> + [WordPressIssue ImproperEscaping Medium pos + "esc_html() used in URL context" + "Use esc_url() for URLs" + (Just "esc_html in href/src")] + where fname = T.toLower $ unName $ last $ qnParts qn + _ -> [] + +-- | Check custom table queries +checkCustomTableSecurity :: Located Expr -> [WordPressIssue] +checkCustomTableSecurity (Located pos expr) = case expr of + ExprMethodCall obj (Name method) args + | isWpdbObject obj + , T.toLower method `elem` wpdbQueryMethods + , hasCustomTable args -> + [WordPressIssue CustomTableInjection High pos + "Custom table query - verify sanitization" + "Use $wpdb->prepare() with %s/%d/%f placeholders" + (Just $ "$wpdb->" <> method)] + _ -> [] + where + wpdbQueryMethods = ["query", "get_results", "get_row", "get_col", "get_var"] + +-- Helper functions + +wpdbFunctions :: [Text] +wpdbFunctions = ["query", "get_results", "get_row", "get_col", "get_var"] + +isWpdbPrepare :: [Argument] -> Bool +isWpdbPrepare args = not (null args) && case locNode (argValue $ head args) of + ExprMethodCall _ (Name "prepare") _ -> True + _ -> False + +isWpdbObject :: Located Expr -> Bool +isWpdbObject (Located _ (ExprVariable (Variable "wpdb"))) = True +isWpdbObject _ = False + +isAjaxAction :: [Argument] -> Bool +isAjaxAction args = not (null args) && case locNode (argValue $ head args) of + ExprLiteral (LitString s) -> "wp_ajax_" `T.isPrefixOf` s + _ -> False + +hasPermissionCallback :: [Argument] -> Bool +hasPermissionCallback args = any isPermissionCallbackArg args + where + isPermissionCallbackArg arg = case locNode (argValue arg) of + ExprLiteral (LitString s) -> "permission_callback" `T.isInfixOf` s + _ -> False + +hasFileValidation :: [Argument] -> Bool +hasFileValidation _args = False -- Simplified + +hasUserInput :: [Argument] -> Bool +hasUserInput = any (containsUserInput . argValue) + where + containsUserInput (Located _ e) = case e of + ExprVariable (Variable v) -> v `elem` ["_GET", "_POST", "_REQUEST", "_COOKIE"] + ExprArrayAccess base _ -> containsUserInput base + _ -> False + +hasMetaKeyValidation :: [Argument] -> Bool +hasMetaKeyValidation _args = False -- Simplified + +hasVariableInQuery :: Argument -> Bool +hasVariableInQuery arg = containsVariable (argValue arg) + where + containsVariable (Located _ e) = case e of + ExprVariable _ -> True + ExprBinary OpConcat left right -> containsVariable left || containsVariable right + _ -> False + +hasFormProcessing :: PhpFile -> Bool +hasFormProcessing file = any (hasPost . locNode) (phpStatements file) + where + hasPost (StmtExpr (Located _ (ExprVariable (Variable "_POST")))) = True + hasPost (StmtExpr (Located _ (ExprArrayAccess (Located _ (ExprVariable (Variable "_POST"))) _))) = True + hasPost _ = False + +hasNonceVerification :: PhpFile -> Bool +hasNonceVerification file = any (hasNonce . locNode) (phpStatements file) + where + hasNonce (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in fn `elem` ["wp_verify_nonce", "check_admin_referer", "check_ajax_referer"] + hasNonce _ = False + +hasAdminPageRegistration :: PhpFile -> Bool +hasAdminPageRegistration file = any (hasAdminPage . locNode) (phpStatements file) + where + hasAdminPage (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in "add_menu_page" `T.isInfixOf` fn || "add_submenu_page" `T.isInfixOf` fn + hasAdminPage _ = False + +hasCapabilityCheck :: PhpFile -> Bool +hasCapabilityCheck file = any (hasCap . locNode) (phpStatements file) + where + hasCap (StmtExpr (Located _ (ExprCall (Located _ (ExprConstant qn)) _))) = + let fn = T.toLower $ unName $ last $ qnParts qn + in fn `elem` ["current_user_can", "user_can", "is_admin"] + hasCap _ = False + +hasTextDomain :: [Argument] -> Bool +hasTextDomain args = length args >= 2 + +hasNonceInContext :: Text -> Bool +hasNonceInContext _fname = False -- Simplified + +isInUrlContext :: SourcePos -> Bool +isInUrlContext _pos = False -- Would need more context + +hasCustomTable :: [Argument] -> Bool +hasCustomTable args = any hasTableRef args + where + hasTableRef arg = case locNode (argValue arg) of + ExprBinary OpConcat _ _ -> True -- Likely custom table prefix + _ -> False + +mkPos :: PhpFile -> SourcePos +mkPos _file = SourcePos "" 1 1 diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/AspectSpec.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/AspectSpec.hs new file mode 100644 index 000000000..8b1501f09 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/AspectSpec.hs @@ -0,0 +1,203 @@ +-- | Aspect Tests - Security, robustness, and error handling for the analyzer itself +-- SPDX-License-Identifier: MPL-2.0 +module AspectSpec (spec) where + +import Test.Hspec +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.ByteString as BS +import Control.Exception (evaluate) +import System.Timeout (timeout) + +import Sanctify.Parser +import Sanctify.Analysis.Security +import Sanctify.Analysis.Advanced +import Sanctify.Transform.Sanitize +import Sanctify.Transform.Strict +import Sanctify.Emit + +-- Aspect tests: Security and robustness of the analyzer itself +spec :: Spec +spec = do + describe "Aspect: Analyzer Security" $ do + it "handles null bytes without crashing" $ do + let code = " pure () -- Parser error acceptable + Right ast -> do + let issues = analyzeSecurityIssues ast + -- Should not crash, issues list may be empty or populated + evaluate (length issues) `shouldReturn` (length issues) + + it "handles extremely long variable names gracefully" $ do + let longName = replicate 10000 'a' + code = T.pack $ " pure () -- Parser failure acceptable + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldSatisfy` (>= 0) + + it "handles deeply nested function calls without stack overflow" $ do + let deepCode = T.pack $ " pure () -- Parser failure acceptable + Right ast -> do + -- Timeout after 5 seconds to catch stack overflow + result <- timeout 5000000 $ + evaluate (length (analyzeSecurityIssues ast)) + case result of + Just _ -> pure () + Nothing -> expectationFailure "Analysis timed out (possible stack overflow)" + + it "handles PHP with BOM (Byte Order Mark) without crashing" $ do + let bomCode = "\xEF\xBB\xBF '\xFFFD') (BS.pack bomCode) + case parsePhpString "test.php" code of + Left _ -> pure () -- Parser error acceptable + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldSatisfy` (>= 0) + + it "handles Latin-1 encoded PHP without crashing" $ do + -- Simulate Latin-1 input (just ASCII-safe for this test) + let code = T.pack " pure () -- Parser error acceptable + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldSatisfy` (>= 0) + + it "handles PHP with invalid UTF-8 sequences gracefully" $ do + let invalidUtf8 = T.pack " pure () -- Parser error acceptable + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldSatisfy` (>= 0) + + describe "Aspect: Analyzer Performance" $ do + it "analyzes small PHP file (10 lines) in reasonable time" $ do + let code = T.pack $ unlines $ + [ " expectationFailure $ show err + Right ast -> do + result <- timeout 1000000 $ -- 1 second timeout + evaluate (length (analyzeSecurityIssues ast)) + case result of + Just _ -> pure () + Nothing -> expectationFailure "Analysis exceeded 1 second" + + it "parses medium PHP file (100 lines) in reasonable time" $ do + let code = T.pack $ unlines $ + [ " expectationFailure $ show err + Right ast -> do + result <- timeout 2000000 $ -- 2 second timeout + evaluate (length (analyzeSecurityIssues ast)) + case result of + Just _ -> pure () + Nothing -> expectationFailure "Analysis exceeded 2 seconds" + + it "emitting large AST completes without hanging" $ do + let code = T.pack $ unlines $ + [ " pure () + Right ast -> do + result <- timeout 1000000 $ -- 1 second timeout + evaluate (T.length (emitPhp ast)) + case result of + Just _ -> pure () + Nothing -> expectationFailure "Emission exceeded 1 second" + + describe "Aspect: Error Handling" $ do + it "non-PHP file extension produces appropriate handling" $ do + let code = " pure () + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldSatisfy` (>= 0) + + it "empty PHP file returns empty issues and valid output" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + issues `shouldBe` [] + emitPhp ast `shouldSatisfy` T.isPrefixOf " expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + issues `shouldBe` [] + + it "unterminated string doesn't cause analyzer to crash" $ do + let code = " pure () -- Parser error acceptable + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldSatisfy` (>= 0) + + it "invalid function calls are handled gracefully" $ do + let code = " pure () -- Parser error acceptable + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldSatisfy` (>= 0) + + describe "Aspect: Transform Safety" $ do + it "strict transform doesn't lose information" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformStrict ast + let original = emitPhp ast + let modified = emitPhp transformed + -- Both should be valid PHP + original `shouldSatisfy` T.isPrefixOf "= T.length original) + + it "sanitize transform produces valid PHP" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformSanitizeOutput ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isPrefixOf " 0) + + describe "Aspect: Concurrent Safety" $ do + it "analyzer is reentrant (multiple concurrent parses)" $ do + let code1 = " do + let issues1 = analyzeSecurityIssues ast1 + let issues2 = analyzeSecurityIssues ast2 + let issues3 = analyzeSecurityIssues ast3 + -- All analyses should complete + length issues1 `shouldSatisfy` (>= 0) + length issues2 `shouldBe` 0 + length issues3 `shouldBe` 0 + _ -> pure () diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/E2ESpec.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/E2ESpec.hs new file mode 100644 index 000000000..637726769 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/E2ESpec.hs @@ -0,0 +1,151 @@ +-- | End-to-End test suite - Full pipeline validation +-- SPDX-License-Identifier: MPL-2.0 +module E2ESpec (spec) where + +import Test.Hspec +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.FilePath (()) +import System.Directory (doesFileExist) +import Control.Exception (catch, SomeException) + +import Sanctify.Parser +import Sanctify.Analysis.Security +import Sanctify.Analysis.Advanced +import Sanctify.WordPress.Security +import Sanctify.Transform.Sanitize +import Sanctify.Transform.Strict +import Sanctify.Emit + +-- E2E test suite: run full sanctify-php pipeline on fixture files +spec :: Spec +spec = do + describe "E2E: Full Pipeline on Fixtures" $ do + it "analyzes vulnerable-sql.php and detects SQL injection" $ do + let fixturePath = "test" "fixtures" "vulnerable-sql.php" + exists <- doesFileExist fixturePath + unless exists $ expectationFailure $ "Fixture not found: " ++ fixturePath + + code <- TIO.readFile fixturePath + case parsePhpString fixturePath code of + Left err -> expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + let sqlIssues = filter (\i -> issueType i == SqlInjection) issues + length sqlIssues `shouldSatisfy` (> 0) + + it "analyzes vulnerable-xss.php and detects XSS" $ do + let fixturePath = "test" "fixtures" "vulnerable-xss.php" + exists <- doesFileExist fixturePath + unless exists $ expectationFailure $ "Fixture not found: " ++ fixturePath + + code <- TIO.readFile fixturePath + case parsePhpString fixturePath code of + Left err -> expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + let xssIssues = filter (\i -> issueType i == CrossSiteScripting) issues + length xssIssues `shouldSatisfy` (> 0) + + it "analyzes wordpress-unsafe.php and detects WordPress issues" $ do + let fixturePath = "test" "fixtures" "wordpress-unsafe.php" + exists <- doesFileExist fixturePath + unless exists $ expectationFailure $ "Fixture not found: " ++ fixturePath + + code <- TIO.readFile fixturePath + case parsePhpString fixturePath code of + Left err -> expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeWordPressSecurity ast + length issues `shouldSatisfy` (> 0) + + it "transforms vulnerable PHP to sanitized form" $ do + let fixturePath = "test" "fixtures" "vulnerable-sql.php" + exists <- doesFileExist fixturePath + unless exists $ expectationFailure $ "Fixture not found: " ++ fixturePath + + code <- TIO.readFile fixturePath + case parsePhpString fixturePath code of + Left err -> expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let transformed = transformSanitizeOutput (transformStrict ast) + let emitted = emitPhp transformed + -- Verify output contains PHP opening tag and is not empty + emitted `shouldSatisfy` T.isPrefixOf " 5) + + it "handles empty PHP file gracefully" $ do + let code = " expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + issues `shouldBe` [] + + it "analyzes PHP 8.2 features file without errors" $ do + let fixturePath = "test" "fixtures" "php82-features.php" + exists <- doesFileExist fixturePath + unless exists $ expectationFailure $ "Fixture not found: " ++ fixturePath + + code <- TIO.readFile fixturePath + case parsePhpString fixturePath code of + Left err -> expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + -- Should parse without error, regardless of issues found + length (phpStatements ast) `shouldSatisfy` (>= 0) + + it "generates valid report for analyzed code" $ do + let code = " expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + issues `shouldSatisfy` (not . null) + -- Report generation should not crash + let report = formatTextReport "test.php" issues + T.length report `shouldSatisfy` (> 0) + + describe "E2E: Clean Code Path" $ do + it "clean_code.php produces no security issues" $ do + let fixturePath = "test" "fixtures" "clean_code.php" + exists <- doesFileExist fixturePath + unless exists $ expectationFailure $ "Fixture not found: " ++ fixturePath + + code <- TIO.readFile fixturePath + case parsePhpString fixturePath code of + Left err -> expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + length issues `shouldBe` 0 + + it "wordpress-safe.php passes WordPress security checks" $ do + let fixturePath = "test" "fixtures" "wordpress-safe.php" + exists <- doesFileExist fixturePath + unless exists $ expectationFailure $ "Fixture not found: " ++ fixturePath + + code <- TIO.readFile fixturePath + case parsePhpString fixturePath code of + Left err -> expectationFailure $ "Parser error: " ++ show err + Right ast -> do + let issues = analyzeWordPressSecurity ast + filter isCriticalWPIssue issues `shouldBe` [] + where + isCriticalWPIssue issue = wpIssueSeverity issue == Critical + +-- Helper function for report formatting +formatTextReport :: String -> [SecurityIssue] -> T.Text +formatTextReport filename issues = + T.unlines $ + [ T.pack $ "Report for " ++ filename + , T.replicate 40 "-" + ] ++ map formatSecurityIssue issues + +formatSecurityIssue :: SecurityIssue -> T.Text +formatSecurityIssue issue = + T.pack $ unwords + [ "[" + , show (issueSeverity issue) + , "]" + , show (issueType issue) + ] diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Main.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Main.hs new file mode 100644 index 000000000..2e50decf7 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Main.hs @@ -0,0 +1,256 @@ +-- | Test suite for Sanctify PHP +-- SPDX-License-Identifier: MPL-2.0 +module Main (main) where + +import Test.Hspec +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Map.Strict as Map + +import Sanctify.Parser +import Sanctify.AST +import Sanctify.Analysis.DeadCode +import Sanctify.Ruleset + +main :: IO () +main = hspec $ do + describe "Sanctify.Analysis.DeadCode" $ do + deadCodeSpecs + describe "Sanctify.Ruleset" $ do + rulesetSpecs + +deadCodeSpecs :: Spec +deadCodeSpecs = do + describe "analyzeDeadCode" $ do + it "detects unused variables" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = analyzeDeadCode file + unusedVars = filter ((== UnusedVariable) . dcType) issues + length unusedVars `shouldBe` 1 + dcIdentifier (head unusedVars) `shouldBe` "unused" + + it "detects unreachable code after return" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = analyzeDeadCode file + unreachable = filter ((== UnreachableCode) . dcType) issues + length unreachable `shouldBe` 1 + + it "detects unreachable code after throw" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = analyzeDeadCode file + unreachable = filter ((== UnreachableCode) . dcType) issues + length unreachable `shouldBe` 1 + + it "detects unused function parameters" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = analyzeDeadCode file + unusedParams = filter ((== UnusedParameter) . dcType) issues + length unusedParams `shouldBe` 1 + dcIdentifier (head unusedParams) `shouldBe` "age" + + it "returns no issues for clean code" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = analyzeDeadCode file + issues `shouldBe` [] + + it "handles variables in closures correctly" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = analyzeDeadCode file + unusedVars = filter ((== UnusedVariable) . dcType) issues + -- $outer and $result should be marked as used, $fn should be used + unusedVars `shouldBe` [] + + it "detects multiple unused variables" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = analyzeDeadCode file + unusedVars = filter ((== UnusedVariable) . dcType) issues + length unusedVars `shouldBe` 2 + + describe "findUnusedVariables" $ do + it "filters only variable-related issues" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = findUnusedVariables file + -- Should have unused parameter and unused variable, but not unreachable + all (\i -> dcType i `elem` [UnusedVariable, UnusedParameter]) issues + `shouldBe` True + + describe "findUnreachableCode" $ do + it "filters only unreachable code issues" $ do + let code = T.unlines + [ " expectationFailure $ "Parse error: " ++ show err + Right file -> do + let issues = findUnreachableCode file + all (\i -> dcType i == UnreachableCode) issues `shouldBe` True + length issues `shouldBe` 1 + +rulesetSpecs :: Spec +rulesetSpecs = do + describe "predefined rulesets" $ do + it "defaultRuleset has security rules enabled" $ do + let rs = defaultRuleset + isRuleEnabled (RuleId "SEC001") rs `shouldBe` True + isRuleEnabled (RuleId "SEC002") rs `shouldBe` True + + it "minimalRuleset disables low-severity rules" $ do + let rs = minimalRuleset + -- Dead code rules should be disabled in minimal + isRuleEnabled (RuleId "DEAD001") rs `shouldBe` False + + it "strictRuleset elevates severity levels" $ do + let rs = strictRuleset + cfg = getRuleConfig (RuleId "SEC010") rs + -- Missing strict_types should be elevated from Info + rcSeverity cfg `shouldSatisfy` (> SeverityInfo) + + it "securityRuleset only enables security category" $ do + let rs = securityRuleset + isRuleEnabled (RuleId "SEC001") rs `shouldBe` True + isRuleEnabled (RuleId "DEAD001") rs `shouldBe` False + isRuleEnabled (RuleId "TYPE001") rs `shouldBe` False + + it "wordpressRuleset enables WP rules" $ do + let rs = wordpressRuleset + isRuleEnabled (RuleId "WP001") rs `shouldBe` True + isRuleEnabled (RuleId "WP002") rs `shouldBe` True + + describe "ruleset operations" $ do + it "enableRule enables a disabled rule" $ do + let rs = disableRule (RuleId "SEC001") defaultRuleset + isRuleEnabled (RuleId "SEC001") rs `shouldBe` False + let rs' = enableRule (RuleId "SEC001") rs + isRuleEnabled (RuleId "SEC001") rs' `shouldBe` True + + it "disableRule disables an enabled rule" $ do + let rs = disableRule (RuleId "SEC001") defaultRuleset + isRuleEnabled (RuleId "SEC001") rs `shouldBe` False + + it "setRuleSeverity changes rule severity" $ do + let rs = setRuleSeverity (RuleId "SEC001") SeverityWarning defaultRuleset + cfg = getRuleConfig (RuleId "SEC001") rs + rcSeverity cfg `shouldBe` SeverityWarning + + it "mergeRulesets overrides rules from base" $ do + let base = defaultRuleset + override = disableRule (RuleId "SEC001") $ + createRuleset "override" "test" [] + merged = mergeRulesets base override + isRuleEnabled (RuleId "SEC001") merged `shouldBe` False + + describe "rule definitions" $ do + it "allRules contains security rules" $ do + let secRules = rulesByCategory CategorySecurity + length secRules `shouldSatisfy` (> 0) + all ((== CategorySecurity) . riCategory) secRules `shouldBe` True + + it "allRules contains dead code rules" $ do + let deadRules = rulesByCategory CategoryDeadCode + length deadRules `shouldSatisfy` (>= 4) + + it "getRuleInfo returns correct info" $ do + case getRuleInfo (RuleId "SEC001") of + Nothing -> expectationFailure "Rule SEC001 not found" + Just info -> do + riCategory info `shouldBe` CategorySecurity + riAutoFixable info `shouldBe` True + + it "getRuleInfo returns Nothing for unknown rule" $ do + getRuleInfo (RuleId "UNKNOWN999") `shouldBe` Nothing + + describe "createRuleset" $ do + it "creates ruleset with specified rules enabled" $ do + let rs = createRuleset "test" "Test ruleset" + [RuleId "SEC001", RuleId "SEC002"] + isRuleEnabled (RuleId "SEC001") rs `shouldBe` True + isRuleEnabled (RuleId "SEC002") rs `shouldBe` True + + describe "getPredefinedRuleset" $ do + it "returns strict ruleset" $ do + case getPredefinedRuleset "strict" of + Nothing -> expectationFailure "strict ruleset not found" + Just rs -> rsName rs `shouldBe` "strict" + + it "returns Nothing for unknown ruleset" $ do + getPredefinedRuleset "nonexistent" `shouldBe` Nothing + + it "is case-insensitive" $ do + getPredefinedRuleset "STRICT" `shouldSatisfy` (/= Nothing) + getPredefinedRuleset "WordPress" `shouldSatisfy` (/= Nothing) diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/ParserSpec.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/ParserSpec.hs new file mode 100644 index 000000000..397bf5585 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/ParserSpec.hs @@ -0,0 +1,103 @@ +-- | Parser test suite - Golden file tests +-- SPDX-License-Identifier: MPL-2.0 +module ParserSpec (spec) where + +import Test.Hspec +import Test.Hspec.Golden +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import System.FilePath (()) + +import Sanctify.Parser +import Sanctify.AST +import Sanctify.Emit + +spec :: Spec +spec = do + describe "PHP 8.2+ Parser" $ do + it "parses readonly classes" $ do + let code = " expectationFailure $ show err + Right ast -> do + phpDeclareStrict ast `shouldBe` False + length (phpStatements ast) `shouldBe` 1 + + it "parses DNF types (A&B)|(C&D)" $ do + let code = " expectationFailure $ show err + Right _ -> pure () -- Successfully parsed + + it "parses match expressions" $ do + let code = " 'one', 2 => 'two', default => 'other' };" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right _ -> pure () + + it "parses enums" $ do + let code = " expectationFailure $ show err + Right _ -> pure () + + it "parses backed enums" $ do + let code = " expectationFailure $ show err + Right _ -> pure () + + it "parses attributes" $ do + let code = " expectationFailure $ show err + Right _ -> pure () + + it "parses constructor promotion" $ do + let code = " expectationFailure $ show err + Right _ -> pure () + + it "parses arrow functions" $ do + let code = " $x * 2;" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right _ -> pure () + + it "parses null coalescing assignment" $ do + let code = " expectationFailure $ show err + Right _ -> pure () + + it "parses trait constants (PHP 8.2)" $ do + let code = " expectationFailure $ show err + Right _ -> pure () + + describe "Parser Round-trip" $ do + it "maintains code structure through parse->emit" $ do + let code = " expectationFailure $ show err + Right ast -> do + let emitted = emitPhp ast + -- Should parse again without error + case parsePhpString "test.php" emitted of + Left err -> expectationFailure $ "Round-trip failed: " ++ show err + Right _ -> pure () + + describe "Error Recovery" $ do + it "reports useful error for syntax error" $ do + let code = " show err `shouldContain` "test.php" + Right _ -> expectationFailure "Should have failed to parse" + + it "handles unclosed braces gracefully" $ do + let code = " pure () -- Expected to fail + Right _ -> expectationFailure "Should have failed to parse" diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/PropertySpec.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/PropertySpec.hs new file mode 100644 index 000000000..052feac7c --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/PropertySpec.hs @@ -0,0 +1,130 @@ +-- | Property-Based Tests - QuickCheck validation +-- SPDX-License-Identifier: MPL-2.0 +module PropertySpec (spec) where + +import Test.Hspec +import Test.QuickCheck +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +import Sanctify.Parser +import Sanctify.Analysis.Security +import Sanctify.Analysis.Advanced +import Sanctify.Transform.Sanitize +import Sanctify.Transform.Strict +import Sanctify.Emit +import Sanctify.AST + +-- Property-based test suite using QuickCheck +spec :: Spec +spec = do + describe "Property: Analysis Determinism" $ do + it "analysis is deterministic (same input → same output)" $ + property $ \phpCode -> + let code = ensureValidPhp phpCode + in case (parsePhpString "test1.php" code, parsePhpString "test2.php" code) of + (Right ast1, Right ast2) -> + let issues1 = analyzeSecurityIssues ast1 + issues2 = analyzeSecurityIssues ast2 + in length issues1 === length issues2 + _ -> property True -- Parser failure is acceptable + + describe "Property: Safe Input Analysis" $ do + it "PHP without vulnerabilities produces empty issue list" $ + property $ \varName -> + let safeCode = T.pack $ + " property True + Right ast -> + let issues = analyzeSecurityIssues ast + in null issues === True + + describe "Property: Transformation Idempotency" $ do + it "sanitize(sanitize(code)) == sanitize(code) for safe inputs" $ + property $ \phpCode -> + let code = ensureValidPhp phpCode + in case parsePhpString "test.php" code of + Left _ -> property True + Right ast -> + let transformed1 = transformSanitizeOutput ast + transformed2 = transformSanitizeOutput transformed1 + emitted1 = emitPhp transformed1 + emitted2 = emitPhp transformed2 + in emitted1 === emitted2 + + describe "Property: Strict Transform Idempotency" $ do + it "strict(strict(code)) preserves structure" $ + property $ \phpCode -> + let code = ensureValidPhp phpCode + in case parsePhpString "test.php" code of + Left _ -> property True + Right ast -> + let transformed1 = transformStrict ast + transformed2 = transformStrict transformed1 + emitted1 = emitPhp transformed1 + emitted2 = emitPhp transformed2 + in emitted1 === emitted2 + + describe "Property: Issue Severity Validity" $ do + it "all returned issues have valid severity levels" $ + property $ \phpCode -> + let code = " property True + Right ast -> + let issues = analyzeSecurityIssues ast + in all isValidSeverity issues === True + + describe "Property: Report Generation" $ do + it "analysis result always produces non-empty report string" $ + property $ \phpCode -> + let code = " property True + Right ast -> + let issues = analyzeSecurityIssues ast + reportLines = map formatIssueLine issues + in if null issues + then property True + else null reportLines === False + + describe "Property: Parser Robustness" $ do + it "parser handles valid PHP 8.2 syntax without crashing" $ + property $ \phpCode -> + let code = T.pack (" property True -- Parse error acceptable + Right _ -> property True -- Success + + describe "Property: Output is Valid PHP" $ do + it "transformed output maintains PHP validity" $ + property $ \phpCode -> + let code = ensureValidPhp phpCode + in case parsePhpString "test.php" code of + Left _ -> property True + Right ast -> + let transformed = transformStrict ast + emitted = emitPhp transformed + in T.take 5 emitted === " T.Text +ensureValidPhp code = + let cleaned = filter (`notElem` "\0\n\r") (take 500 code) + in T.pack $ " Bool +isValidSeverity issue = + let sev = issueSeverity issue + in sev `elem` [Info, Low, Medium, High, Critical] + +-- Helper: Format issue for report +formatIssueLine :: SecurityIssue -> String +formatIssueLine issue = + unwords + [ "[" ++ show (issueSeverity issue) ++ "]" + , show (issueType issue) + ] diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/SecuritySpec.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/SecuritySpec.hs new file mode 100644 index 000000000..1337eb5a0 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/SecuritySpec.hs @@ -0,0 +1,150 @@ +-- | Security analysis test suite - Vulnerability detection +-- SPDX-License-Identifier: MPL-2.0 +module SecuritySpec (spec) where + +import Test.Hspec +import qualified Data.Text as T + +import Sanctify.Parser +import Sanctify.Analysis.Security +import Sanctify.Analysis.Advanced +import Sanctify.WordPress.Security +import Sanctify.AST (Located) + +spec :: Spec +spec = do + describe "SQL Injection Detection" $ do + it "detects direct query with variable concatenation" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + any (\i -> issueType i == SQLInjection) issues `shouldBe` True + + it "detects WordPress $wpdb query without prepare" $ do + let code = "query(\"UPDATE posts SET views = views + 1 WHERE id = \" . $_GET['id']);" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + length (filter (\i -> issueType i == SQLInjection) issues) `shouldSatisfy` (> 0) + + it "allows safe $wpdb->prepare usage" $ do + let code = "query($wpdb->prepare(\"UPDATE posts SET views = %d WHERE id = %d\", $views, $id));" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + filter (\i -> issueType i == SQLInjection) issues `shouldBe` [] + + describe "XSS Detection" $ do + it "detects echo of unsanitized $_GET" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + any (\i -> issueType i == CrossSiteScripting) issues `shouldBe` True + + it "detects echo of $_POST without escaping" $ do + let code = "\" . $_POST['content'] . \"\";" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + length (filter (\i -> issueType i == CrossSiteScripting) issues) `shouldSatisfy` (> 0) + + it "allows properly escaped output" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + filter (\i -> issueType i == CrossSiteScripting) issues `shouldBe` [] + + describe "Command Injection Detection" $ do + it "detects shell_exec with user input" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + any (\i -> issueType i == CommandInjection) issues `shouldBe` True + + it "detects exec with user input" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeSecurityIssues ast + any (\i -> issueType i == CommandInjection) issues `shouldBe` True + + describe "Advanced Security - ReDoS" $ do + it "detects catastrophic backtracking pattern (.*)* " $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = concatMap checkReDoS (allExprs ast) + length issues `shouldSatisfy` (> 0) + + it "detects nested quantifiers (.+)+" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = concatMap checkReDoS (allExprs ast) + length issues `shouldSatisfy` (> 0) + + describe "Advanced Security - SSRF" $ do + it "detects file_get_contents with user-controlled URL" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = concatMap checkSSRF (allExprs ast) + length issues `shouldSatisfy` (> 0) + + it "detects wp_remote_get with user input" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = concatMap checkSSRF (allExprs ast) + length issues `shouldSatisfy` (> 0) + + describe "WordPress Security" $ do + it "detects missing nonce verification in form handler" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeWordPressSecurity ast + any (\i -> wpIssueType i == MissingNonce) issues `shouldBe` True + + it "detects missing capability check" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeWordPressSecurity ast + any (\i -> wpIssueType i == MissingCapability) issues `shouldBe` True + + it "allows proper nonce and capability checks" $ do + let code = " expectationFailure $ show err + Right ast -> do + let issues = analyzeWordPressSecurity ast + filter (\i -> wpIssueType i `elem` [MissingNonce, MissingCapability]) issues `shouldBe` [] + +-- Helper to extract all expressions from AST for testing +allExprs :: PhpFile -> [Located Expr] +allExprs file = concatMap stmtExprs (phpStatements file) + where + stmtExprs (Located _ (StmtExpr e)) = [e] + stmtExprs (Located _ (StmtReturn (Just e))) = [e] + stmtExprs (Located _ (StmtIf cond then_ else_)) = + cond : concatMap stmtExprs then_ ++ maybe [] (concatMap stmtExprs) else_ + stmtExprs _ = [] diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Spec.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Spec.hs new file mode 100644 index 000000000..e88a2e9cb --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/Spec.hs @@ -0,0 +1,4 @@ +-- | Main test suite runner +-- SPDX-License-Identifier: MPL-2.0 + +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/TransformSpec.hs b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/TransformSpec.hs new file mode 100644 index 000000000..0ff825713 --- /dev/null +++ b/rhodium-standard-repositories/satellites/cccp/satellites/sanctify-php/test/TransformSpec.hs @@ -0,0 +1,223 @@ +-- | Transformation test suite - Sanitization and hardening +-- SPDX-License-Identifier: MPL-2.0 +module TransformSpec (spec) where + +import Test.Hspec +import qualified Data.Text as T + +import Sanctify.Parser +import Sanctify.AST +import Sanctify.Emit +import Sanctify.Transform.Sanitize +import Sanctify.Transform.Strict +import Sanctify.Transform.TypeHints (transformAddTypeHints) + +spec :: Spec +spec = do + describe "Strict Types Transform" $ do + it "adds declare(strict_types=1) when missing" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformStrict ast + phpDeclareStrict transformed `shouldBe` True + + it "preserves existing declare(strict_types=1)" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformStrict ast + phpDeclareStrict transformed `shouldBe` True + -- Should not duplicate the declaration + + it "adds ABSPATH check to WordPress files" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformWordPressSecurity ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "ABSPATH" + + describe "Output Escaping Transform" $ do + it "wraps echo with esc_html for plain text" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformSanitizeOutput ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "esc_html" + + it "wraps echo with esc_attr for attributes" $ do + let code = "';" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right ast -> do + let transformed = transformSanitizeOutput ast + let emitted = emitPhp transformed + -- Should detect attribute context + emitted `shouldSatisfy` T.isInfixOf "esc_attr" + + it "does not wrap already escaped output" $ do + let code = " expectationFailure $ show err + Right ast -> do + let original = emitPhp ast + let transformed = transformSanitizeOutput ast + let emitted = emitPhp transformed + -- Should not double-escape + emitted `shouldBe` original + + describe "Input Sanitization Transform" $ do + it "wraps $_GET access with sanitize_text_field" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformSanitizeInput ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "sanitize_text_field" + + it "wraps $_POST email with sanitize_email" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformSanitizeInput ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "sanitize_email" + + it "does not wrap already sanitized input" $ do + let code = " expectationFailure $ show err + Right ast -> do + let original = emitPhp ast + let transformed = transformSanitizeInput ast + let emitted = emitPhp transformed + emitted `shouldBe` original + + describe "SQL Preparation Transform" $ do + it "wraps $wpdb->query with prepare" $ do + let code = "query(\"SELECT * FROM posts WHERE id = \" . $_GET['id']);" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right ast -> do + let transformed = transformSQLPrepare ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "$wpdb->prepare" + emitted `shouldSatisfy` T.isInfixOf "%d" + + it "does not wrap already prepared queries" $ do + let code = "query($wpdb->prepare(\"SELECT * FROM posts WHERE id = %d\", $id));" + case parsePhpString "test.php" code of + Left err -> expectationFailure $ show err + Right ast -> do + let original = emitPhp ast + let transformed = transformSQLPrepare ast + let emitted = emitPhp transformed + emitted `shouldBe` original + + describe "Redirect Safety Transform" $ do + it "adds exit after wp_redirect" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformRedirectSafety ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "wp_redirect" + emitted `shouldSatisfy` T.isInfixOf "exit" + + it "adds exit after header Location redirect" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformRedirectSafety ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "exit" + + it "does not add duplicate exit" $ do + let code = " expectationFailure $ show err + Right ast -> do + let original = emitPhp ast + let transformed = transformRedirectSafety ast + let emitted = emitPhp transformed + -- Should not add second exit + T.count "exit" emitted `shouldBe` T.count "exit" original + + describe "Type Hint Addition" $ do + it "infers and adds return type from return statement" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformAddTypeHints ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf ": int" + + it "infers parameter type from usage" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformAddTypeHints ast + let emitted = emitPhp transformed + -- Should infer numeric type from multiplication + emitted `shouldSatisfy` \t -> T.isInfixOf "int" t || T.isInfixOf "float" t + + it "does not override existing type hints" $ do + let code = " expectationFailure $ show err + Right ast -> do + let original = emitPhp ast + let transformed = transformAddTypeHints ast + let emitted = emitPhp transformed + emitted `shouldBe` original + + describe "Crypto Modernization" $ do + it "replaces rand() with random_int()" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformModernizeCrypto ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "random_int" + emitted `shouldNotSatisfy` T.isInfixOf "rand" + + it "replaces md5() with SHAKE3-256" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformModernizeCrypto ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "hash('sha3-256'" + + it "replaces sha1() with BLAKE3" $ do + let code = " expectationFailure $ show err + Right ast -> do + let transformed = transformModernizeCrypto ast + let emitted = emitPhp transformed + emitted `shouldSatisfy` T.isInfixOf "sodium_crypto_generichash" + + describe "Transformation Idempotence" $ do + it "applying transforms twice produces same result" $ do + let code = " expectationFailure $ show err + Right ast -> do + let once = transformSanitizeOutput ast + let twice = transformSanitizeOutput once + emitPhp once `shouldBe` emitPhp twice