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