github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-28 21:40:34 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'develop' into iop-vc-preview

Browse Source 
Both conflicts are tail appends onto regions develop rewrote. In
migrations.clj keep both appended blocks, develop's two entries
first so the branch's four stay the tail of the vector. In
climit.edn take develop's rewritten entries and re-append the
branch's provisional block, moving the map's closing brace to the
last line.

AI-assisted-by: glm-5.3-flash
Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
This commit is contained in:
Álvaro Tejero Cantero 2026-10-14 16:34:48 +02:00
commit 6ab7b3ebd6
No known key found for this signature in database
462 changed files with 29714 additions and 10227 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.agents/README.md
View File

@ -508,6 +508,7 @@ JSON, REPL access, and so on.
| [`ste`](skills/ste/SKILL.md) | Rewrites prose in Simplified Technical English. Loads only when you name it. |
| [`refine-prompt`](skills/refine-prompt/SKILL.md) | Rewrites a rough prompt into a clearer one. Never runs the prompt. |
| [`update-changelog`](skills/update-changelog/SKILL.md) | Regenerates `CHANGES.md` from a GitHub milestone. |
| [`find-project-anomalies`](skills/find-project-anomalies/SKILL.md) | Checks a milestone against the Main project board and reports anomalies to `tmp/<MILESTONE>-ANOMALIES.md`. |
### A typical round

8
.agents/skills/code-review-criteria/SKILL.md
View File

@ -105,7 +105,7 @@ For detailed security guidance, see `security-and-hardening`.
| **Low:** | Minor, optional | Author may ignore — formatting, style preferences |
| **Suggestion:** | Worth considering | Not required, but improves the code |
**Unique finding IDs.** Assign every finding a stable identifier: `F1`, `F2`, `F3`, … numbered in order of severity (Critical first, then High, Medium, Low, Suggestion). Use the ID everywhere the finding is mentioned — in section headers, in the verdict, in follow-up discussion. Never renumber within a review. Example: `**F3 (High)** — `app/validate.cljs:42` — duplicate branch logic…`.
**Finding IDs.** Assign every finding a stable identifier by severity class: `R1`, `R2`, … for required findings (Critical, High), `M1`, `M2`, … for minor findings (Medium, Low), and `S1`, `S2`, … for suggestions. Number within each class in review order. Use the ID everywhere the finding is mentioned — in section headers, in the verdict, in follow-up discussion. Never renumber within a review. Example: `**R2** — `app/validate.cljs:42` — duplicate branch logic…`.
For each finding, describe the circumstances under which it could fail: specific inputs, load conditions, timing, or user actions that trigger the problem. "This crashes when input is null" is actionable; "this might crash" is not.
@ -123,11 +123,11 @@ Briefly explain what the code does and give an overall assessment.
### Critical and High-Priority Issues
List problems that could cause security incidents, data loss, crashes, incorrect behavior, or major performance degradation. Each finding gets its unique ID (`F1`, `F2`, …). For each: state the severity, identify the file/function/code section, explain why it's a problem, describe failure circumstances, and provide a concrete improvement with corrected code when useful.
List problems that could cause security incidents, data loss, crashes, incorrect behavior, or major performance degradation. Each finding gets its unique ID (`R1`, `R2`, …). For each: state the severity, identify the file/function/code section, explain why it's a problem, describe failure circumstances, and provide a concrete improvement with corrected code when useful.
### Other Findings
List medium- and low-priority issues, including maintainability and design concerns. Continue the ID sequence started above (`F3`, `F4`, …).
List medium- and low-priority issues, including maintainability and design concerns. Use `M1`, `M2`, … for Medium/Low and `S1`, `S2`, … for Suggestions.
### Suggested Refactoring
@ -149,7 +149,7 @@ Choose one:
- **Approve with minor changes** — Good to merge after addressing low/medium issues
- **Request changes** — Critical or high issues must be resolved before merge
List the finding IDs the verdict depends on (e.g. "Request changes: F1, F4").
List the finding IDs the verdict depends on (e.g. "Request changes: R1, R2").
## Change Sizing

116
.agents/skills/find-project-anomalies/SKILL.md Normal file
View File

@ -0,0 +1,116 @@
---
name: find-project-anomalies
description: Check a GitHub milestone against the Main project board, report the five anomaly types to tmp/<MILESTONE>-ANOMALIES.md, and fix missing milestone assignments on request.
---
# Skill: find-project-anomalies
Check every issue and PR in a given GitHub milestone against the Main
project board. Report the five anomaly types below, then fix the ones a
human confirms.
## Getting the version ($ARGUMENTS)
The milestone version comes from the skill arguments (`$ARGUMENTS`), the
same way other skills receive theirs. Accept `2.17.0`, `v2.17.0`,
`milestone 2.17.0`, or any text clearly containing one `X.Y.Z` version.
If no version is given and none can be deduced from the arguments or the
conversation context, **stop and ask the user** which milestone to check.
Do not guess, do not default to the latest release.
## When to Use
- Before a release, to catch board/milestone drift while there is still time
to fix it
- After triage sessions, to verify every milestone item is tracked, owned,
and correctly assigned
- Whenever someone asks "is milestone X.Y.Z clean on Main?"
## Prerequisites
- `gh` CLI authenticated (`gh auth status`)
- Python 3.8+
- `scripts/gh.py` for GitHub queries, `scripts/project-anomalies.py` for
detection and reporting (`python3 scripts/project-anomalies.py check --help`)
## Workflow
### 1. Resolve the version (see above), then run the check
```bash
python3 scripts/project-anomalies.py check "2.17.0"
# explicit path:
python3 scripts/project-anomalies.py check "2.17.0" --output tmp/2.17.0-ANOMALIES.md
```
This fetches milestone issues and PRs in bulk (one GraphQL call per 50
items), resolves outsiders the same way, and overwrites
`tmp/<MILESTONE>-ANOMALIES.md`. Every number renders as a full
`[#N](https://github.com/penpot/penpot/issues/N)` or
`[#N](https://github.com/penpot/penpot/pull/N)` link.
### 2. Read the report and judge each anomaly
The five types, in report order:
1. **OPEN issue with a MERGED PR** — the fix landed but the issue never
closed (or it reopened). Fix: close the issue, or move it out of the
milestone if the fix did not actually land here.
2. **Milestone issue, PR elsewhere or issue off Main** — a *merged* closing
PR in another milestone (or none), or the issue itself not on the Main
board. An unmerged PR's milestone means nothing (it landed nowhere), so
it never triggers this type. Fix: align the milestones (see step 3), or
add the issue to Main.
3. **Milestone PR, issue elsewhere or off Main** — the mirror view over
*merged* PRs only: a PR released here closes an issue tracked elsewhere
(or nowhere on Main). Unmerged PRs never trigger this type — their
milestone means nothing yet. Fix: align the milestones (see step 3), or
add the issue to Main.
4. **MERGED PR on a `needs triage` issue** — landed without triage. Only a
human can triage; never auto-remove the label.
5. **MERGED PR on an unassigned, non-community issue** — no owner and no
`community contribution` label (checked on both issue and PR). Either
assign an owner or confirm it is community work. Never invent an owner.
Scope notes (deliberate, not bugs):
- Project membership is checked **on the issue side only**. PRs are not the
unit tracked on Main, so an unprojected PR alone is never an anomaly.
- An issue with *no* milestone closed by a milestone PR **is** reported
here (type 3): unlike the changelog flow, this pairing always needs a
human look.
### 3. Fix missing milestone assignments (only these, only on confirmation)
The only mechanical fix in this skill is assigning a missing milestone.
The report already prints the exact command next to each such case:
```bash
gh pr edit <PR> --milestone "<MILESTONE>"
gh issue edit <ISSUE> --milestone "<MILESTONE>"
```
Rules:
- Apply **only** when one side lacks a milestone. When both sides have
*different* milestones, a human decides which one moves — never pick a
side yourself.
- Confirm **each fix (or each small batch)** with the user before running
it. Read back what the command will change.
- Everything else (closing issues, triaging, assigning owners, adding
items to the Main board) is human work: point at it, do not do it.
### 4. Re-run until clean
After fixes land, re-run step 1 and confirm the report shows zero
anomalies. The `tmp/` report is scratch output (gitignored): quote or
paste entries into chat when reporting back, do not commit it.
## Key Principles
- **No version, no run.** Stop and ask when the milestone is unknown.
- **Report first, touch nothing.** No board or milestone changes without
explicit per-item confirmation.
- **Milestone gaps auto-fix; judgment calls do not.** Only a missing
milestone is mechanical. triage, ownership, and close/reopen decisions
belong to humans.
- **Every number clickable.** The report is useless without full GitHub links.

20
.agents/skills/review-code/SKILL.md
View File

@ -67,6 +67,26 @@ agent again.
6. Skip generated files, lockfile-only changes, and unrelated modifications
unless they introduce security risks.
## Posting as a GitHub comment
Only post the review as a comment when the user asks for it explicitly. Keep
it in the session otherwise.
When posting: PR comments go in English, with this minimal structure:
1. **Intro line** — one sentence: what was found and the overall tone. No
greetings.
2. **`## Main issues`** — one subsection per required finding: what breaks,
the failure circumstances, and the minimal fix (code snippet when useful).
A missing test belongs here, not under minor suggestions.
3. **`## Minor suggestions`** — one bullet per minor finding or suggestion:
file/function, problem, concrete remedy.
4. **Closing** — optional and short. Cut it when it adds nothing.
Reference every finding by its ID (`R1`, `M1`, `S1`, … from
`code-review-criteria`) so follow-up replies can point to findings
unambiguously.
## User input, overrides and additional context
$ARGUMENTS

944
.agents/skills/update-changelog/SKILL.md
View File

File diff suppressed because it is too large Load Diff

20
.github/dependabot.yml vendored
View File

@ -1,20 +0,0 @@
# https://docs.github.com/code-security/dependabot/dependabot-version-updates/configuration-options-for-the-dependabot.yml-file
version: 2
updates:
# Actions are pinned to a commit SHA with a `# vX.Y.Z` comment; Dependabot
# bumps both. All updates are grouped into a single monthly PR.
- package-ecosystem: "github-actions"
directory: "/"
schedule:
interval: "monthly"
open-pull-requests-limit: 5
labels:
- "dependencies"
- "team infra"
- "no issue required"
commit-message:
prefix: ":arrow_up:"
groups:
github-actions:
patterns:
- "*"

10
.github/workflows/auto-label.yml vendored
View File

@ -13,8 +13,14 @@ permissions: {}
jobs:
triage:
# Dependabot PRs are labelled by dependabot.yml and do not need triage.
if: github.actor != 'dependabot[bot]'
# The Renovate Dependency Dashboard and Renovate's GitHub Actions PRs do
# not need triage. Other Renovate PRs (base images, Node.js, pnpm) do.
if: >-
!(github.event_name == 'issues'
&& github.event.issue.user.login == 'penpot-renovate[bot]')
&& !(github.event_name == 'pull_request_target'
&& github.event.pull_request.user.login == 'penpot-renovate[bot]'
&& github.event.pull_request.head.ref == 'renovate-github-actions')
runs-on: ubuntu-latest
steps:
- name: Generate GitHub App token

27
.github/workflows/build-docker-devenv.yml vendored
View File

@ -6,22 +6,34 @@ on:
permissions:
contents: read
concurrency:
group: build-docker-devenv
cancel-in-progress: false
jobs:
build-and-push:
name: Build and push DevEnv Docker image
runs-on: penpot-standar-runner
timeout-minutes: 90
env:
DOCKER_IMAGE: 'penpotapp/devenv'
steps:
- name: Set common environment variables
run: |
# Each job execution will use its own docker configuration.
echo "DOCKER_CONFIG=${{ runner.temp }}/.docker-${{ github.run_id }}-${{ github.job }}" >> $GITHUB_ENV
echo "DOCKER_CONFIG=${RUNNER_TEMP}/.docker-${GITHUB_RUN_ID}-${GITHUB_JOB}" >> "$GITHUB_ENV"
- name: Checkout code
uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
with:
persist-credentials: false
- name: Set up QEMU
uses: docker/setup-qemu-action@99012661954931238ded8c8b007157a8430204e1 # v4.4.0
with:
platforms: linux/amd64,linux/arm64
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@f87e5991a6d7451dcb8d9637bfbc97413f497069 # v4.4.1
@ -40,8 +52,6 @@ jobs:
- name: Build and push DevEnv Docker image
uses: docker/build-push-action@c3c9e263c25d99ce0380d002d59b67737d91b0dc # v7.4.0
env:
DOCKER_IMAGE: 'penpotapp/devenv'
with:
context: ./docker/devenv/
file: ./docker/devenv/Dockerfile
@ -61,4 +71,13 @@ jobs:
TEXT: |
🚀 *[PENPOT] New devenv available*
📄 You may want to update your devenv.
@alvaro
- name: Notify Mattermost (developers)
uses: mattermost/action-mattermost-notify@ae31bb6f9e26a54336e79696f108a2c91cf55b4e # v2.1.0
with:
MATTERMOST_WEBHOOK_URL: ${{ secrets.MATTERMOST_WEBHOOK }}
MATTERMOST_CHANNEL: penpotdev
TEXT: |
🚀 *[PENPOT] New devenv available*
📄 You may want to update your devenv.
(\cc @alvaro)

256
.github/workflows/build-renovate.yml vendored Normal file
View File

@ -0,0 +1,256 @@
name: Renovate Docker Image Check
# Triggered by pushes to Renovate branches, not by pull_request: this is a
# public repository and these jobs run on the self-hosted runners, so a PR
# from a fork must never be able to start them. Only users with write
# access can push here.
on:
push:
branches:
- 'renovate-*'
permissions: {}
concurrency:
group: renovate-image-check-${{ github.ref_name }}
cancel-in-progress: true
env:
BUNDLE_CACHE: /var/tmp/penpot-bundle-cache
jobs:
# ── 1. Pick an existing develop bundle and detect what changed ────────
prepare:
name: Prepare
runs-on: penpot-standar-runner
timeout-minutes: 10
permissions:
contents: read
outputs:
short_sha: ${{ steps.bundle.outputs.short_sha }}
images: ${{ steps.changes.outputs.images }}
devenv: ${{ steps.changes.outputs.devenv }}
imagemagick: ${{ steps.changes.outputs.imagemagick }}
steps:
- name: Checkout code
uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
with:
persist-credentials: false
fetch-depth: 0
- name: Find the develop commit this branch is based on
id: base
run: |
echo "sha=$(git merge-base HEAD origin/develop)" >> "$GITHUB_OUTPUT"
- name: Detect changed images
id: changes
env:
BASE_SHA: ${{ steps.base.outputs.sha }}
run: |
changed() {
git diff --quiet "$BASE_SHA" HEAD -- "$@" && echo false || echo true
}
{
# Anything outside .github can affect the production images.
echo "images=$(changed . ':!.github')"
echo "devenv=$(changed docker/devenv)"
echo "imagemagick=$(changed docker/imagemagick)"
} >> "$GITHUB_OUTPUT"
# Renovate only changes Dockerfiles and package manager versions, so
# the most recent develop bundle is enough to build the images.
- name: Find the latest develop bundle
id: bundle
env:
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_DEFAULT_REGION: ${{ secrets.AWS_REGION }}
S3_BUCKET: ${{ secrets.S3_BUCKET }}
BASE_SHA: ${{ steps.base.outputs.sha }}
run: |
for SHA in $(git rev-list --first-parent --max-count=50 "$BASE_SHA"); do
SHORT_SHA=$(git rev-parse --short=12 "$SHA")
if aws s3api head-object --bucket "$S3_BUCKET" \
--key "penpot-sha-${SHORT_SHA}.zip" > /dev/null 2>&1; then
echo "short_sha=$SHORT_SHA" >> "$GITHUB_OUTPUT"
echo "Using bundle \`penpot-sha-${SHORT_SHA}.zip\`" >> "$GITHUB_STEP_SUMMARY"
exit 0
fi
done
echo "::error::No bundle found for the last 50 develop commits"
exit 1
# ── 2. Production images, built from the PR Dockerfiles ───────────────
images:
name: Build ${{ matrix.image }}
runs-on: penpot-standar-runner
timeout-minutes: 60
needs: prepare
if: needs.prepare.outputs.images == 'true'
permissions:
contents: read
strategy:
fail-fast: false
max-parallel: 3
matrix:
image: [backend, frontend, exporter, storybook, mcp]
steps:
- name: Set common environment variables
env:
MATRIX_IMAGE: ${{ matrix.image }}
run: |
echo "DOCKER_CONFIG=${RUNNER_TEMP}/.docker-${GITHUB_RUN_ID}-${GITHUB_JOB}-${MATRIX_IMAGE}" >> "$GITHUB_ENV"
- name: Checkout code
uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
with:
persist-credentials: false
- name: Login to Docker Registry
uses: docker/login-action@dbcb813823bdd20940b903addbd779551569679f # v4.6.0
with:
registry: ${{ secrets.DOCKER_REGISTRY }}
username: ${{ secrets.DOCKER_USERNAME }}
password: ${{ secrets.DOCKER_PASSWORD }}
- name: Login to DockerHub Registry
uses: docker/login-action@dbcb813823bdd20940b903addbd779551569679f # v4.6.0
with:
username: ${{ secrets.PUB_DOCKER_USERNAME }}
password: ${{ secrets.PUB_DOCKER_PASSWORD }}
- name: Login to Docker Hardened Images registry
uses: docker/login-action@dbcb813823bdd20940b903addbd779551569679f # v4.6.0
with:
registry: dhi.io
username: ${{ secrets.PUB_DOCKER_USERNAME }}
password: ${{ secrets.PUB_DOCKER_PASSWORD }}
- name: Prepare Penpot bundle
env:
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_DEFAULT_REGION: ${{ secrets.AWS_REGION }}
S3_BUCKET: ${{ secrets.S3_BUCKET }}
SHORT_SHA: ${{ needs.prepare.outputs.short_sha }}
IMAGE: ${{ matrix.image }}
run: |
ZIP="$BUNDLE_CACHE/penpot-sha-${SHORT_SHA}.zip"
if [ ! -f "$ZIP" ]; then
mkdir -p "$BUNDLE_CACHE"
aws s3 cp "s3://${S3_BUCKET}/penpot-sha-${SHORT_SHA}.zip" "$ZIP.$$.tmp"
mv "$ZIP.$$.tmp" "$ZIP"
fi
pushd docker/images
unzip -q "$ZIP" "penpot/${IMAGE}/*"
mv "penpot/${IMAGE}" "bundle-${IMAGE}"
popd
- name: Set up QEMU
uses: docker/setup-qemu-action@99012661954931238ded8c8b007157a8430204e1 # v4.4.0
with:
platforms: linux/amd64,linux/arm64
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@f87e5991a6d7451dcb8d9637bfbc97413f497069 # v4.4.1
- name: Build Docker image
uses: docker/build-push-action@c3c9e263c25d99ce0380d002d59b67737d91b0dc # v7.4.0
with:
context: ./docker/images/
file: ./docker/images/Dockerfile.${{ matrix.image }}
platforms: linux/amd64,linux/arm64
push: false
cache-from: type=registry,ref=${{ secrets.DOCKER_REGISTRY }}/${{ matrix.image }}:buildcache
# ── 3. Devenv, only when the PR touches it ────────────────────────────
devenv:
name: Build devenv
runs-on: penpot-standar-runner
timeout-minutes: 90
needs: prepare
if: needs.prepare.outputs.devenv == 'true'
permissions:
contents: read
steps:
- name: Set common environment variables
run: |
echo "DOCKER_CONFIG=${RUNNER_TEMP}/.docker-${GITHUB_RUN_ID}-${GITHUB_JOB}" >> "$GITHUB_ENV"
- name: Checkout code
uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
with:
persist-credentials: false
- name: Login to DockerHub Registry
uses: docker/login-action@dbcb813823bdd20940b903addbd779551569679f # v4.6.0
with:
username: ${{ secrets.PUB_DOCKER_USERNAME }}
password: ${{ secrets.PUB_DOCKER_PASSWORD }}
- name: Login to Docker Hardened Images registry
uses: docker/login-action@dbcb813823bdd20940b903addbd779551569679f # v4.6.0
with:
registry: dhi.io
username: ${{ secrets.PUB_DOCKER_USERNAME }}
password: ${{ secrets.PUB_DOCKER_PASSWORD }}
- name: Set up QEMU
uses: docker/setup-qemu-action@99012661954931238ded8c8b007157a8430204e1 # v4.4.0
with:
platforms: linux/amd64,linux/arm64
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@f87e5991a6d7451dcb8d9637bfbc97413f497069 # v4.4.1
- name: Build devenv image
uses: docker/build-push-action@c3c9e263c25d99ce0380d002d59b67737d91b0dc # v7.4.0
with:
context: ./docker/devenv/
file: ./docker/devenv/Dockerfile
platforms: linux/amd64,linux/arm64
push: false
cache-from: type=registry,ref=penpotapp/devenv:buildcache
# ── 4. ImageMagick, only when the PR touches it ───────────────────────
# amd64 only: compiling ImageMagick under QEMU takes too long for a check.
imagemagick:
name: Build imagemagick
runs-on: penpot-standar-runner
timeout-minutes: 60
needs: prepare
if: needs.prepare.outputs.imagemagick == 'true'
permissions:
contents: read
steps:
- name: Set common environment variables
run: |
echo "DOCKER_CONFIG=${RUNNER_TEMP}/.docker-${GITHUB_RUN_ID}-${GITHUB_JOB}" >> "$GITHUB_ENV"
- name: Checkout code
uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1
with:
persist-credentials: false
- name: Login to Docker Hardened Images registry
uses: docker/login-action@dbcb813823bdd20940b903addbd779551569679f # v4.6.0
with:
registry: dhi.io
username: ${{ secrets.PUB_DOCKER_USERNAME }}
password: ${{ secrets.PUB_DOCKER_PASSWORD }}
- name: Set up Docker Buildx
uses: docker/setup-buildx-action@f87e5991a6d7451dcb8d9637bfbc97413f497069 # v4.4.1
- name: Build imagemagick image
uses: docker/build-push-action@c3c9e263c25d99ce0380d002d59b67737d91b0dc # v7.4.0
with:
context: ./docker/imagemagick/
file: ./docker/imagemagick/Dockerfile
platforms: linux/amd64
push: false

5
.github/workflows/tests-exporter.yml vendored
View File

@ -61,3 +61,8 @@ jobs:
working-directory: ./exporter
run: |
./scripts/test
- name: Check no invoke_* in exporter JS glue
working-directory: ./render-wasm
run: |
./check-no-invoke-v export

10
.github/workflows/tests-wasm.yml vendored
View File

@ -60,3 +60,13 @@ jobs:
working-directory: ./render-wasm
run: |
./test
- name: Build
working-directory: ./render-wasm
run: |
NODE_ENV=production ./build frontend
- name: Check no invoke_*V in JS glue
working-directory: ./render-wasm
run: |
./check-no-invoke-v

3
.gitignore vendored
View File

@ -83,6 +83,7 @@ opencode.json
/web
/library/target/
/library/*.zip
/library/.shadow-cljs
/external
/penpot-nitrate
/test-results/
@ -90,6 +91,7 @@ opencode.json
/blob-report/
/playwright/.cache/
/render-wasm/target/
/render-wasm/.render-wasm-build.lock
/media-processor/dist/
/media-processor/target/
/**/node_modules
@ -110,6 +112,7 @@ opencode.json
/.opencode/reports
/.opencode/prompts
/.ci-logs
/tmp/
/.codex/
/tools/__pycache__
/scripts/__pycache__

1
.serena/memories/backend/auth-permissions-product-domains.md
View File

@ -19,6 +19,7 @@
- `app.rpc.permissions` provides predicate/check factories. Failed permission checks intentionally raise `:not-found` / `:object-not-found`, not an authorization-specific error, to avoid leaking object existence.
- Team role flags are normalized as owner > admin > editor > viewer. Owner/admin imply edit; any membership row implies read.
- File/project role rows only count with a live team membership: the file/project permission queries require a matching `team_profile_rel` row, and leaving or removing a member deletes their team-scoped `file`/`project`/`team-project-profile-rel` rows (GHSA-v9r9-h77c-55m2).
- File/project/comment checks are implemented in the owning command namespaces, often via helpers imported from `files`, `teams`, or `projects`; do not bypass those helpers with direct DB lookups unless preserving their not-found semantics.
- Comment permission includes both logged-in state and the file/team comment policy. Shared viewer paths may pass `share-id`; preserve that path when changing comment queries.

20
.serena/memories/backend/core.md
View File

@ -4,7 +4,7 @@ Backend: JVM Clojure; Integrant; PostgreSQL; Redis/Valkey; RPC; HTTP; storage; m
## Focused memories
- Cross-cutting backend subtleties (RPC, DB, workers, cron, HTTP/sessions, storage, file data): `mem:backend/subtleties`
- Cross-cutting backend subtleties (RPC, DB, workers, cron, CLIMIT, HTTP/sessions, storage, file data): `mem:backend/subtleties`
- Storage abstraction, logical buckets, object lifecycle, deduplication, access, and garbage collection: `mem:backend/storage`.
- Embedded Ladybug graph experiment, projection, incremental sync, console, and risks: `mem:backend/graph-experiment`
- Session lifetime config, token `:exp`, and idle/absolute GC: `mem:backend/session-expiration`.
@ -24,6 +24,7 @@ Backend: JVM Clojure; Integrant; PostgreSQL; Redis/Valkey; RPC; HTTP; storage; m
- `app.worker`: task execution/cron plumbing.
- `app.main`: Integrant system map and component wiring.
- `app.config`: `PENPOT_*` env config and feature flags.
- `app.health`: per-process availability flag; `/readyz` answers 503 while offline. Flipped from `app.srepl.main` (`set-offline` / `set-online`).
- `app.srepl.*`: development REPL helpers for manual backend operations (data inspection, migration helpers, one-off admin tasks).
- `app.nitrate`, `app.rpc.commands.nitrate`, and `app.rpc.management.nitrate`: external Nitrate subscription/organization integration, gated by the `:nitrate` feature flag and shared-key HTTP calls.
@ -57,10 +58,19 @@ For deeper details on transaction semantics, advisory locks, Transit vs JSON hel
Every background job is a job-def: a plain `(defn execute-X [cfg params] ...)` in its namespace + a malli params schema + an `ig/init-key` that returns the job-def map `{::jobs/name, ::jobs/schema, ::jobs/handler, ::jobs/decoder, ::jobs/validator}` (decoder/validator precompiled at init). The registry is the `::jobs/defs` wiring in `app.main`, which also populates a module-level registry used by `jobs/submit` as fallback — job-def components cannot ig/ref `::jobs/defs` (wiring cycle). Submit from RPC code passes its RPC cfg (it carries `::jobs/defs` via ig/ref).
- `::jobs/handler` is `(fn [context params] ...)`. It is NOT given the runner cfg: a job-def closes over its own dependencies, and handing it the runner cfg would let a handler reach the pool or any other component. A wrapper passes the context to its implementation only when the implementation takes it; most do not, and their implementation stays `[cfg params]`.
- The context is built by `jobs/make-context` and has exactly four keys: `id`, `name`, `label`, `resource-id`, behind a closed schema. `queue` is absent on purpose (a routing detail of the dispatcher, not a property of the job) and so are `retry-num`/`max-retries`/`attempt` (retry policy belongs to the runner, and an attempt number cannot be durable because the `noop` strategy re-runs without incrementing the counter).
- The context is built by `jobs/make-context` and has exactly five keys: `id`, `name`, `label`, `resource-id`, `profile-id`, behind a closed schema. `profile-id` is the owner of a user-facing job and nil for an internal one, and it is there so a handler can revalidate permissions and check who owns its resource without a second query. `queue` is absent on purpose (a routing detail of the dispatcher, not a property of the job) and so are `retry-num`/`max-retries`/`attempt` (retry policy belongs to the runner, and an attempt number cannot be durable because the `noop` strategy re-runs without incrementing the counter).
- `jobs/invoke` is the in-process escape hatch: it delivers a nil context without a row, validates and delivers `::jobs/context` when given, and keeps `::jobs/job-id` independent. `::jobs/context` and `::jobs/job-id` are cfg options, not params.
- Business params live in the `params` column (plain JSON, decoded with the job-def decoder). `submit` takes an optional `::jobs/profile-id` and `::jobs/resource-id`, both validated as UUIDs and stored as columns; nothing is inferred from `params`. No caller passes a profile-id yet.
- `heartbeat` uses named options `[cfg & {:keys [job-id progress] :as options}]` and returns the number of durable writes. The job id falls back to `::jobs/job-id` on the cfg and then to the runner-bound `*job-id*`. A progress report needs `current`, allows optional `total` and `stage` (max 250 chars) and takes no other key.
- Business params live in the `params` column (plain JSON, decoded with the job-def decoder). `submit` takes optional `::jobs/profile-id`, `::jobs/resource-id` (both validated as UUIDs) and `::jobs/expires-at` (an instant: the retention the jobs GC sweeps by), all stored as columns; nothing is inferred from `params`. The binfile creation commands are the callers that pass a profile-id and a resource.
- A job-def may carry optional metadata keys read from the registry by its consumers, never by the substrate: `::jobs/family` (e.g. `:export`) groups the jobs of a family for quotes, `::jobs/resource-role` (`:input` or `:output`) says whether the job's `resource_id` is what it consumes or what it produces, and `::jobs/queue-name` names the queue the creation command routes the job to (`submit-job` falls back to `:binfile` when the def does not set it).
- Job resources (`app.jobs.storage`) are the objects a job owns through `job.resource_id`: they live in the `job-resource` bucket, are written with the profile of the job as owner (only that profile can read them back from `/assets/by-id`) and are never deduplicated. They carry no expiry of their own, because `expired-at` is stored as `deleted_at` and an object with it is unreadable from birth: the retention of the artifact is the retention of its job row. The writer marks the object as touched right away, so an artifact that no row references (a crash between the upload and the completion) is reclaimed by `storage-gc-touched`, and a row that does reference it freezes it until the jobs GC deletes the row and touches the object.
- The binfile jobs (`:export-binfile` and `:import-binfile`) run the core of `bf.v1`/`bf.v3` through `app.binfile.jobs`, which turns the `:progress` taps of the core into `progress` events of the job with `jobs/heartbeat` (the `modified_at` touch at most once per second, progress events at up to ~200ms). Each event is a self-contained milestone: a `:stage` keyword of one vocabulary shared by the two formats (the same work has a different name in v1 and v3) and an optional `:counters` map, with the counter of the activity named after its own stage and the outer scopes in course as context, which the tap carries itself (the reader puts `::outer-counters` in every tap inside them — today only `:files`, extendable to `:teams`/`:projects` for multi-scope exports — so the adapter remembers nothing between taps and a tap that happens outside any scope has no context); the ids and names the taps carry never reach the event. Every tap is reported, so a tap with no units to count still keeps the job alive, and a milestone the throttle drops loses nothing because the next one carries the same state. The adapter checks that the job is still active before the run, and the beat raises an `:interrupt` right there on the run thread when the job is no longer active, so the work stops at its next event point inside the transaction of its handler, which rolls back. A run whose last tap predates the interruption is discarded by the check once it returns. The adapter passes the job id from the handler context. Their job-def components carry pool, storage, metrics and msgbus, because a job with a `profile_id` cannot store an event without a msgbus on its cfg. Both readers answer with the same shape (`:file-ids` and, in version 3, the resolution of the libraries), because the version 1 reader returns a bare set of file ids.
- Both binfile handlers revalidate their permission at run time, not only when the job is created, because it can be revoked while the job waits: the export checks the read permission of every file before reading anything and stores the package in `job-resource` as the resource of the job (answering with the completion envelope), and the import checks the edition permission of the destination and runs the core inside a transaction, which is what makes a cancelled import roll back instead of leaving half of a file. The import releases its package (marks it as deleted and drops the reference from the job row in the same transaction) and deletes its temporary copy once the job is terminal, whatever the outcome. Both handlers check their own result against a schema before returning it, because the job-def has no result schema of its own.
- The domain cfg of a binfile request lives in `app.binfile.common` (`export-cfg`, `import-cfg`), so the legacy RPC and the jobs freeze the same ids, resolve the same team features and apply the same anti-zip-bomb limits. `resolve-export-type` is the translation the legacy RPC needs for its deprecated boolean flags; the creation command asks the caller for the type instead of guessing a default.
- Two retention knobs, easy to confuse: `:jobs-retention` sweeps terminal internal rows (the ones without a profile), while `:jobs-user-ttl` is the default expiry a user-facing job gets when it is created; the jobs GC deletes the row once `expires_at` passes and touches its resource. The heavy work of a user job runs on its own `:binfile` queue (`:worker-binfile-parallelism`, default 1) so it does not block the default runner.
- The quote of a family of jobs (`::export-jobs-per-profile`, `::import-jobs-per-profile`) counts the jobs of the profile that are still on their way (`new`/`scheduled`/`running`/`retry`) whose name the registry gives for that family, so a new job of the family is covered without touching the quote.
- A user-facing job is created through `app.rpc.commands.jobs`. One command per job type: `create-export-binfile-job` and `create-import-binfile-job` name the job they create and their body carries only `:params`, whose schema the command imports from the job namespace (`::sm/params`), so the RPC validates the business params up front, before the command runs; the job-def is still the place that owns them and validates them again at run time. The commands check the permission and the quote of the family before the expensive part, submit with `max-retries 0`, an expiry from `:jobs-user-ttl` and the queue the job-def routes to through `::jobs/queue-name` (`:binfile` when the def says nothing; read by the command, never by the substrate), and answer with a summary of the row. The import command has its own creation schema (`import-binfile/schema:create-params`, version optional) because the request is not the stored params: the command fills the version (from the caller or the package header) and the manifest metadata kept for audit. It assembles the upload, reads the manifest of a version 3 package for the audit (never its content) and stores the package in `job-resource` as the resource of the job, releasing it when the job never comes to own it.
- `get-job` is the read surface a profile has over its own jobs: it answers with the same summary the creation commands return plus the `result` of a finished job or its public error (through `decode-job-error`, so the keywords come back), and a job of another profile is not distinguishable from one that does not exist: both answer `not-found`. `decode-row` decodes `params`, `result` and `error`, and the result is the plain JSON the row holds, so a uuid comes back as the text it is on disk (a result has no schema of its own like the params do). The event log still has no read surface: a client that follows a job takes its progress from the websocket.
- `heartbeat` uses named options `[cfg & {:keys [job-id progress] :as options}]` and returns the number of durable writes, so 0 means there was nothing to write: no job context, or the throttle did not allow it. A write that finds the job no longer active (terminal or gone) raises an `:interrupt` (`code :job-interrupted`, carrying the job id and the status it found) through the shared `jobs/check-active` instead of counting zero, so a task in course stops at its next beat; the interrupt is internal and never reaches HTTP (the management progress report answers `:skip` for it). The job id falls back to `::jobs/job-id` on the cfg and then to the runner-bound `*job-id*`. The `modified_at` touch is throttled to ~1s and the progress event to ~200ms, so the check fires at most once per second with no extra query (the read of the row happens only when a write already found nothing). A progress report is a milestone (`schema:progress`): a required `:stage` keyword plus an optional `:counters` map of `scope -> {:current, :total?}`, and no other key. Counters are non-negative, a `total` is positive and never lower than its `current`, and stage and counter keys are names of at most 64 characters. A milestone without counters is valid (a point of the run with no units to count), the stage vocabulary belongs to the worker and not to the substrate, and a client must degrade for a stage it does not know. Read a stored payload back with `jobs/decode-progress`: the database holds the keywords as strings. The 1s beat (down from 60s, so a cancelled heavy job is seen as gone at its next beat) costs one `modified_at` touch per beating job per second: cheap while the only heavy beater runs alone on its queue, revisit if concurrent beating jobs ever grow.
- `job.error` conforms to `app.jobs/schema:job-error` (`type` and `code` keywords, `hint` text, extra details allowed). Read it back with `jobs/decode-job-error`; a plain `db/decode-json-pgobject` leaves the keywords as strings. `complete` takes named options and an optional `resource-id`, which is only ever set, never replaced: it reads the row locked inside its own transaction and applies the rules in a fixed order, skipping a job that is no longer completable before refusing one for its resource, so the answer is a function of the row and not of the order two callers arrive in.
For worker dispatch, cron, retry semantics (`ex/raise :type ::wrk/retry` with `:delay`/`:strategy`), deduplication, job events, and queue internals: `mem:backend/subtleties`.
@ -113,7 +123,7 @@ Fixtures can populate local data for manual testing/perf work. From the backend
* **Type Hinting:** Use explicit JVM type hints (e.g. `^String`, `^long`) in performance-critical paths to avoid reflection overhead.
* **Batch inserts:** Use `db/insert-many!` for bulk row inserts — generates a single SQL with multiple parameter tuples. Avoid on very large datasets (SQL length / parameter count limits).
* **Server-side cursors:** Use `db/plan` (fetch-size 1000, forward-only, read-only) or `db/cursor` for large result sets. Never fetch large collections into memory at once.
* **Server-side cursors:** Use `db/plan` (fetch-size 1000, forward-only, read-only) for large result sets. Never fetch large collections into memory at once. `db/plan` is an `IReduceInit`: `reduce`/`transduce` over it (`sequence` does not work on it), and with `partition-all` the transducer's completing arity is what flushes the last partial chunk. A plan row is a **view over the open result set**, valid only inside the reducing function: read the columns you need right there — buffering rows to read them later (a `partition-all` buffer, a lazy seq) silently yields nil columns. `db/cursor` (manual `DECLARE`/`FETCH`) is a leftover with no callers left.
* **Transaction discipline:** Use `tx-run!` for writes (opens a transaction), `run!` for reads (single connection, no transaction). Set `:read-only` on `tx-run!` when applicable to let PostgreSQL optimize.
## Lint and Format

12
.serena/memories/backend/storage.md
View File

@ -25,16 +25,16 @@
- Existing object values can remain readable until physical deletion.
- `:expired-at` blocks reads after the expiration time.
- `del-object!` sets `deleted_at` on live rows only (`deleted_at IS NULL`): a repeated call returns `false`. It does not remove backend content.
- `storage-gc-deleted` removes the database row and backend content after the deletion delay.
- `storage-gc-deleted` removes the database row and backend content after the deletion delay, streaming the pending rows with `db/plan` inside a read-only transaction and deleting them in chunks of 25, each chunk in its own transaction: a chunk that fails (for example, an object a foreign key still references) is logged and skipped instead of aborting the run. A physical-deletion failure inside a chunk defers its rows one day (`deletion_attempts + 1`) and gives up after 7 attempts, accepting the orphan blob; chunk mappings (`upload_session_chunk`) are removed before the `storage_object` rows (NO ACTION foreign keys).
- `storage-gc-touched` finds references before it sets `deleted_at`.
- `objects-gc` removes deleted domain rows and touches their storage object IDs.
- `objects-gc` removes deleted domain rows and touches their storage object IDs. Each proc streams its pending keys with `db/plan` inside a read-only transaction and deletes them in chunks, each chunk in its own transaction with `FOR UPDATE SKIP LOCKED`: a chunk that fails is logged and skipped instead of aborting the run.
- Use `::db/reuse-conn true` with `sto/resolve` inside a database transaction.
## GC Cost Model
- `sto/touch-object!` is one `UPDATE storage_object SET touched_at`: DB-only, never touches S3/FS backend content.
- Physical FK cascades are avoided by convention; domain deletion is logical (`deleted_at`) everywhere. GC removes small objects first, then parents, then grandparents (see `deletion-proc-vars` order in `app.tasks.objects-gc`). Per-row delete cost is small and bounded.
- `objects-gc` sweeps in chunks of 100 (`::chunk-size`, overridable per job params); `storage-gc-deleted` in chunks of 25. Each chunk is one transaction: cursor fetch + single-row deletes/updates + commit.
- Physical FK cascades are avoided by convention; domain deletion is logical (`deleted_at`) everywhere. GC removes small objects first, then parents, then grandparents (see the call order in `app.tasks.objects-gc/execute-objects-gc`). Per-row delete cost is small and bounded.
- `objects-gc` sweeps in chunks of 100 (`::chunk-size`, overridable per job params); `storage-gc-deleted` in chunks of 25. The cursor that streams the pending keys runs in a read-only transaction of its own (`db/plan`), and every chunk is deleted in a transaction of its own: the cursor fetch and the deletes are never the same transaction.
- Consequence: per-chunk cost is DB-only and bounded, so these sweeps cannot outrun the 30-minute jobs lease in practice (would need millions of pending rows in one proc). Per-chunk `heartbeat` where present is belt-and-braces, not load-bearing.
## Connection Reuse Details
@ -77,6 +77,7 @@ Since `put-object!` uses backend-specific operations (`impl/resolve-backend` + `
- Objects can therefore share content across users and files within one bucket.
- Deleted objects are not reused.
- `tempfile` objects never use deduplication, even when the caller requests it.
- `job-resource` objects never use deduplication either, whatever the caller asks: the object belongs to one profile, and a shared blob would serve the artifact of one user to the job of another. `put-object!` excludes the bucket from the dedupable set, so the invariant does not depend on call sites.
- Use `sto/wrap-with-hash` when the caller already calculated the content hash.
## Bucket Rules
@ -94,7 +95,7 @@ Since `put-object!` uses backend-specific operations (`impl/resolve-backend` + `
| `file-data` | Encoded file data when `file-data-backend` is `storage`. Reference metadata has `storage-ref-id`, `file-id`, and the `file_data` row ID. | Yes | Authentication required | Reference scan. |
| `file-data-fragment` | Compatibility value for file-data fragments. The current backend has no dedicated producer for this bucket. | No current write semantics | Public | No touched-object collector case. |
| `file-change` | Compatibility value for file changes. Current snapshots store data in `file_data`, not this bucket. | No current write semantics | Authentication required | No touched-object collector case. |
| `job-resource` | Storage objects owned by job rows (`job.resource_id`). | Yes | Authentication required | jobs-GC touch → reference scan. |
| `job-resource` | Storage objects owned by job rows (`job.resource_id`), written by `app.jobs.storage`. | No | Authentication required, owner-scoped | jobs-GC touch → reference scan. |
- The valid bucket set is `app.storage.schema/metadata-buckets` (derived from `bucket-requirements`, where a new bucket and its required metadata keys are one entry); `app.storage/valid-buckets` aliases it.
- `file-media-object` is the default bucket for old rows without bucket metadata.
@ -108,6 +109,7 @@ Since `put-object!` uses backend-specific operations (`impl/resolve-backend` + `
- `app.http.assets` decides direct object authentication from the bucket.
- Public buckets are `file-media-object`, `file-object-thumbnail`, `team-font-variant`, `file-data-fragment`, and `organization`.
- Other valid buckets require a session or access-token profile ID.
- `tempfile` and `job-resource` are owner-scoped: the request must come from the profile stored in the object metadata, and a mismatch answers 404 (counted as `unauthorized`). A missing owner is tolerated only in `tempfile`, where legacy objects predate the metadata; `job-resource` always carries one, so an object without it is never served.
- File-media routes also require file read permission.
- Non-public direct responses set `content-disposition: attachment`.
- FS responses use `x-accel-redirect` for the configured asset path.

23
.serena/memories/backend/subtleties.md
View File

@ -9,6 +9,18 @@
- Params with `::sm/params` are decoded/conformed through the JSON transformer and successful IObj results get `:encode/json` metadata. Legacy spec conforming only applies when no Malli params schema exists. Client params are stripped of qualified keys (`d/without-qualified`) before merging with the server auth context, so request bodies cannot override `::profile-id`, `::auth-type`, or `::token-perms`.
- Params schemas are open by default, so undeclared client keys reach the handler unless the map is `:closed true`. Creation commands (`create-file`, `create-project`, `create-team`, `create-team-with-invitations`, `upload-file-media-object`, `create-file-media-object-from-url`, `assemble-file-media-object`) use closed schemas: a client-provided `:id` fails with `:params-validation`. Their internal creation functions still accept an optional explicit `:id` for imports, duplicates and deterministic test fixtures.
- Nil RPC bodies become HTTP 204 unless explicit status metadata is present. Stream bodies default to `application/octet-stream` when no content type is set.
- The upload schema (`media.v/schema:upload`) takes a `:path` from the caller, and a Transit body can tag any string as a `path`, so a command that reads such an upload reads a file the client named. `create-import-binfile-job` avoids that boundary by accepting only a chunked upload (`:upload-id`); the commands that still take a plain file (the legacy `import-binfile`, the media and font uploads) trust it, and the guard belongs where uploads are accepted, not in each command.
## Concurrency limiter (CLIMIT)
- `::climit/id` is either a plain keyword, which gives one shared limiter per process, or the vector form `[[id key-fn]]`, which gives one limiter per key. `climit/wrap` takes the key only from that positional `key-fn` (`climit/get-limits` maps a plain keyword to a single-element vector), so `::climit/key-fn` is metadata that nothing reads: a command declaring `::climit/id :x/by-profile` next to it ends up with a single shared limiter, and the missing key is visible in the `app.rpc.climit` log lines, whose `id` carries no key suffix. That is what happened to `push-audit-events`, the last user of the dead metadata, from `a5c6d78ee5` (2024-01-27, "fix some fundamental bugs on climit module", which moved the key to the vector form without updating it) until it was fixed; nothing declares `::climit/key-fn` any more, so keep using the vector form for anything that must be per profile.
- A gauge written by whichever limiter of a name ran last cannot show a queue: every per-profile limiter of the name collapses into one series, so a healthy profile writing 0 overwrites the 15 of the one that is queueing (measured in production: 4 of 1441 samples). `penpot_rpc_climit_waiting` replaces it and is accumulated: one counter per name and instance, up when a call starts waiting for a permit, down when it stops, so a call that enters and never leaves keeps the value above zero for ever. `penpot_rpc_climit_rejected_total` counts rejections by name and `reason`: `queue-full` when the error carries `:size`, `timeout` when it carries `:timeout` (both carry `:code :capacity-limit-reached`, so the timeout field is the discriminator). The two gauges that could not tell the truth (`penpot_rpc_climit_queue`, `penpot_rpc_climit_permits`) were deleted, and so was `penpot_http_worker_busy_threads`, which reads 0 on an instance with 72 blocked threads: `penpot_http_worker_pool_size` is the signal for retained threads. A stuck limiter also shows up in `penpot_rpc_climit_timing_count` (the acquired path), which is a counter: compare the same limiter name across instances and the stuck one reads 0 acquisitions while its peer reads thousands. In thread dumps it reads as threads parked in `psm/acquire` whose CPU time does not grow between two dumps, on an instance that is otherwise idle.
- The waiting counters are a field of the `ConcurrencyLimiter` component (a `ConcurrentHashMap` of name to `AtomicLong`), so they start at zero, die with the component, and the sampler that closes over that map republishes only its own names every 15 s; the sampler stops with the component in `halt-key!`. `impl-invoke` pairs one decrement with one increment through a per-call flag: the flag turns a second call into a no-op and the `finally` guarantees that there is one. The increment sits inside the `try` and the decrement lives only in the acquired callback and the `finally`, so a handler that throws, a rejection and a throwable from the publishing path all leave the count where it was and the thread without the limiter marked as held (a leftover mark would skip that limiter for that key for ever). Concurrent `inc`/`dec` publications of two threads can land out of order and the value can read low for a moment; the republish corrects it.
- The `app.rpc.climit` log lines carry `queue`, `queue-max`, `permits`, `elapsed`, `code` and `reason`, and their `id` carries the key (`name/<profile or key>`). That is the only place where the profile behind a queue is visible: a pile-up is chased there, on demand, not in the metrics. The `queue` of the line is the calls inside the limiter minus its permits, so it reads 0 for a lone caller that times out: that line goes out at TRACE instead of WARN, and the rejection count has to come from the metric.
- Nothing in the limiter path has a timeout unless the config sets one, and `psm/acquire` then calls `Semaphore.acquire`, which parks the calling thread forever. A parked thread still counts as in-system for every outer limiter of its chain, so the outermost one (the method's own by-profile limiter) stops granting permits and answers 429 to everything. A limiter without `:queue` gets an unlimited queue and therefore never rejects: its pile-up is silent, with no 429 and no log line except the WARN `enqueued`/`acquired` lines of the keyed id.
- Deadlock shape between a command's own limits and the root ones (fixed): a command declaring its own limits held `process-image/by-profile` before `root/by-profile`, while a command with no limits of its own takes the roots first and then re-enters with the same keyed limits from inside its handler (`create-file-media-object-from-url`, `upload-photo`) and waits for them holding a root permit. Two calls of one profile then held the same two limiters inverted and parked for good: 69 threads at 0 CPU, an audit limiter with 0 acquisitions in 24h and 100% 429s, on an instance that never served a 204.
- `climit/wrap` now appends the root limiters after the command's own, so `root/global`/`root/by-profile` end up outermost and every path meets them first; the nested `climit/invoke!` chains carry only the command's own limits and run inside them, which puts both paths in the same order. `impl-invoke` also keeps, per thread, the set of limiters that thread is inside of and runs the handler inline when a call asks for one it already holds, instead of queueing behind itself. That check relies on `pbh/invoke!` running the handler on the calling thread; the mark is removed in a `finally`. Commands declare the by-profile limit before the global one, which makes it the outermost of the pair: keep that declaration order, the reverse one would put two paths back in inverted order. The two nested call sites (`create-file-media-object-from-url`, `upload-photo`) still share `process-image` with the enclosing call instead of getting a limiter of their own, so the comment there about keeping the download out of that limit no longer holds.
- The shipped `backend/resources/climit.edn` sets a timeout on every limiter, 60s for operations that can be slow and 30s otherwise, with a test that fails when an entry ships without one, and `init-key` logs a WARN for every entry without a timeout. The production file lives outside the repository: mirror it there, and remember that a parked thread only goes away with a restart or a deploy.
## DB helpers
@ -23,9 +35,10 @@
## Workers and cron
- `job` carries `tenant` (the instance the job belongs to) and a bare `queue`. Several instances share one database and the tenant is what keeps an instance from claiming another environment's jobs, so every query that acts on one instance's work filters on `tenant`: dispatch claim, orphan sweep, lost-job reschedule, cron no-overlap count, submit dedupe. The `job__dispatcher__idx` leads with `tenant` (equality) then `(priority DESC, scheduled_at)`; `queue` does not lead because the dispatcher claims every queue of its tenant. The `<tenant>:<queue>` prefix survives only in the Redis key, composed once by `app.worker/queue-key`.
- Submit dedupe only removes not-yet-due `new` jobs of the same tenant with the same name/queue/label; it does not dedupe due, scheduled, retry, running, or completed work.
- Submit dedupe only removes not-yet-due `new` jobs of the same tenant with the same name/queue/label; it does not dedupe due, scheduled, retry, running, or completed work. The `::jobs/skip-if-active` submit option goes further: it skips the insert (returning `nil`, recording `penpot_jobs_skipped_total`) when a live job (`new`/`scheduled`/`running`/`retry`) already exists for the same tenant/name/queue/label, requires an explicit non-blank label, and carries the same best-effort cross-backend race caveat as dedupe.
- Jobs metrics rule (one event, one family): counters exist only for events without latency; when an event has a histogram, its `_count` is the counter (no twin counter). `dispatched` (pushes) vs `queue-wait` (claims) are deliberately different events — do not merge them.
- The dispatcher selects `new`/`retry` jobs with `FOR UPDATE SKIP LOCKED`, marks them `scheduled`, and publishes the JSON payload `[id scheduled-at]` to the `penpot.worker.queue:<tenant>:<queue>` Redis list. The runner skips Redis messages whose scheduled timestamp no longer matches DB state.
- Lost `scheduled` jobs are rescheduled after 5 minutes; `running` jobs untouched longer than `:jobs-lease` (default 30 min) are marked `aborted` with `app.jobs/orphan-error` (`type :internal`, `code :orphan`). `aborted` is a system-side terminal state like `cancelled` (never retried, swept by retention like other terminals, reported with an error log); long jobs must `heartbeat` per chunk so a healthy backlog is never mistaken for a dead process. The `:progress` report is optional and only feeds the durable log.
- Lost `scheduled` jobs are rescheduled after 5 minutes; `running` jobs untouched longer than `:jobs-lease` (default 30 min) are marked `aborted` with `app.jobs/orphan-error` (`type :internal`, `code :orphan`). `aborted` is a system-side terminal state like `cancelled` (never retried, swept by retention like other terminals, reported with an error log); long jobs must `heartbeat` per chunk so a healthy backlog is never mistaken for a dead process. The `:progress` report is optional and only feeds the durable log. A beat whose write finds the job no longer active raises an `:interrupt` (`code :job-interrupted`) instead of counting zero: it is the internal stop-the-work signal, not an error, so neither the listener nor the runner logs it as one.
- An orphan gets its `end` event (`outcome "aborted"`) from the sweep itself: one bulk `INSERT ... SELECT` in the same transaction as the bulk `UPDATE`, never one insert per orphan. No msgbus notification goes out for it; orphans alert through the error log and the orphaned counter.
- `job_event` is append-only and deleted by cascade with the job. `progress` is a row there, not a column: no Redis and no mutable column to keep in sync.
- `job` is deletion-protected at the SQL level (`deletion_protection__tgr`): a stray `DELETE FROM job` raises instead of dropping the row and its `job_event` cascade without touching the referenced `storage_object`. The only intended deleters, the jobs GC and the submit dedupe, disable the guard with `SET LOCAL rules.deletion_protection TO off` inside their transaction; tests use `th/db-force-delete`.
@ -36,6 +49,7 @@
## Config and HTTP/session middleware
- `app.config/config` and `flags` are dynamic `defonce` vars populated from `PENPOT_*` env vars through the shared schema string transformer. Tests and tooling can bind them.
- Duration config values are parsed as ISO-8601 with the `PT` prefix, so a day is written in hours (`:jobs-retention` and `:jobs-user-ttl` default to a week, and an operator writes `168h`): `7d` does not parse, and the value fails validation at boot instead of being silently ignored.
- `parse-flags` automatically adds `:disable-secure-session-cookies` when `public-uri` is plain HTTP and not localhost. This changes cookie defaults without an explicit env flag.
- The backend sets Clojure `*assert*` globally from the `:backend-asserts` feature flag. Assertion-dependent checks can therefore differ by runtime flags.
- Request body parsing is mostly POST-oriented and supports Transit JSON plus plain JSON. Plain JSON request keys are kebab-decoded before being merged into `:params`.
@ -48,8 +62,9 @@
## HTTP server self-metrics
- `app.http` enables Undertow connection statistics via the yetti option `:server/statistics` (requires yetti ≥ v11.11, which exposes it; before the patch `ListenerInfo#getConnectorStatistics` returned `nil`).
- A daemon sampler built on `promesa.exec` (`px/scheduled-executor` plus a self-rescheduling `px/schedule` chain, so a failing sample never cancels the next one; 15 s, started with the server in `ig/init-key` and stopped with `px/shutdown-now` in `halt-key!`) publishes worker and listener state: `penpot_http_worker_queue_size`, `busy_threads`, `pool_size`, `max_pool_size`, `penpot_http_connector_active_connections`, `requests_total`, `errors_total`. Definitions live in `app.main/default-metrics`.
- The xnio worker MXBean can return transient `-1` (e.g. busy-thread count); negative samples are discarded (gauge keeps its previous value). Undertow exposes absolute request/error totals, so the sampler keeps a watermark atom and publishes deltas; a counter reset (decreasing totals) skips the negative delta and moves the watermark forward.
- `app.metrics/create-sampler` holds the sampler shape: a single daemon `px/scheduled-executor` thread with a self-rescheduling `px/schedule` chain, so a failing sample never cancels the next one; the owner starts it in `ig/init-key` and stops it with `px/shutdown-now` in its `halt-key!`. Http and CLIMIT both sample every 15 s.
- `app.http` uses it to publish worker and listener state: `penpot_http_worker_queue_size`, `penpot_http_worker_pool_size`, `penpot_http_worker_max_pool_size`, `penpot_http_connector_active_connections`, `penpot_http_connector_requests_total`, `penpot_http_connector_errors_total`. Definitions live in `app.main/default-metrics`. The xnio busy-thread count is not published: it reads 0 with threads blocked inside a limiter, which is why it was deleted.
- The xnio worker MXBean can return transient `-1` (e.g. on the queue or the pool size); negative samples are discarded (gauge keeps its previous value). Undertow exposes absolute request/error totals, so the sampler keeps a watermark atom and publishes deltas; a counter reset (decreasing totals) skips the negative delta and moves the watermark forward.
- The `process_*` families (`process_open_fds`, `process_max_fds`, `process_cpu_seconds_total`, …) come from the prometheus client `StandardExports`, registered by `app.metrics/create-registry`. They read the OS MXBean reflectively and need the `jdk.management` module: on a pruned `jlink` JRE the MXBean is `sun.management.BaseOperatingSystemImpl`, the getters throw `NoSuchMethodException` and `StandardExports#collect` swallows it, so those families silently vanish from `/metrics`. `docker/images/Dockerfile.backend` keeps `jdk.management` in the `--add-modules` list, and `backend-tests.metrics-test` pins the contract.
## Metrics recording

22
.serena/memories/backend/testing.md
View File

@ -6,10 +6,28 @@ JVM `clojure.test` (kaocha runner) under `backend/test/backend_tests/`.
- All CLI commands must be executed from the `backend/` subdirectory.
- Tests are invoked directly via `clojure -M:dev:test` (kaocha) — there is no pnpm wrapper. Kaocha auto-discovers test namespaces, so no runner registration is needed.
- **Preferred way to run them: `scripts/ci <module> --test`**, which runs lint, tests and format per module and writes a log per task under `.ci-logs/`. It exports `PENPOT_FLAGS` with `enable-backend-asserts` appended, so use it rather than calling `clojure -M:dev:test` by hand.
- **Why the flag matters:** `clojure.core/assert` is elided at compile time when `*assert*` is false, and `app.config` only sets that var from the flags when it loads. The test fixture redefines the flags after that, so they never reach it: without the flag the suite runs with every assertion compiled out, and a test that depends on an assert only means something with it set. GitHub Actions sets it too. When running the suite directly, the command is `PENPOT_FLAGS="enable-backend-asserts" clojure -M:dev:test`.
- **Why the flag matters:** `clojure.core/assert` is elided at compile time when `*assert*` is false, and `app.config` only sets that var from the flags when it loads. The test fixture redefines the flags after that, so they never reach it: without the flag the suite runs with every assertion compiled out, and a test that depends on an assert only means something with it set. `scripts/ci` and `tests-backend.yml` export the flag (GitHub Actions sets it too). When running the suite directly — including a `--focus` run — the command is `PENPOT_FLAGS="enable-backend-asserts" clojure -M:dev:test`.
- Coverage: if code is added or modified in `src/`, corresponding tests in `test/backend_tests/` must be added or updated.
- Isolated run: `clojure -M:dev:test --focus backend-tests.my-ns-test` for a specific test namespace, or `clojure -M:dev:test --focus backend-tests.my-ns-test/my-test-var` for a specific test var.
- Multiple focus symbols are supported by REPEATING the flag (kaocha accumulates them, last-wins does not apply): `clojure -M:dev:test --focus backend-tests.ns-one --focus backend-tests.ns-two` — preferred over a shell loop of isolated runs.
- Regression run: `clojure -M:dev:test` to ensure no regressions in related functional areas.
- If you need to filter output, tee to a temp file first: `clojure -M:dev:test 2>&1 | tee /tmp/penpot-test-output.txt`.
- RPC test helpers `command!`/`management-command!` split the data map: qualified keys become server params, unqualified keys become request body params. To inject request-level context (headers, `:app.http/auth-key-id`, ip), pass a map under `:app.http/request` metadata; non-map `IRequest` stubs fall back to a dummy request.
- RPC test helpers `command!`/`management-command!` split the data map: qualified keys become server params, unqualified keys become request body params. To inject request-level context (headers, `:app.http/auth-key-id`, ip), pass a map under `:app.http/request` metadata; non-map `IRequest` stubs fall back to a dummy request.
- The test system is `main/system-config` + `main/worker-config` with the
components that must not run in the background dropped: HTTP, the srepl,
cron, the dispatcher and **every** `[<profile> :app.worker/runner]`
(`helpers/remove-job-runners`). A live runner of any queue races the tests
that drive the loop by hand (`wdisp/run-batch` + `@#'wrkr/run-worker-loop`):
it takes the job the test just dispatched and completes it behind the test's
back, so the test's own assertions read a state it did not produce. Do not
re-add a runner by editing that list by hand; the removal matches by key
shape on purpose.
- `system-config` and `worker-config` are `def`s: their `(cf/get ...)` calls
are evaluated when the namespace loads, against the real environment, while
test code calling `cf/get` at run time sees the `penpot-test`-prefixed
config. The two can disagree — in the devenv `:tenant` is `devenv-ws0` for
the defs and `default` inside a test — so a component built from
`worker-config` can talk to a different Redis key prefix than a cfg the test
builds itself. The symptom is a component that silently does nothing
locally and races in CI (which sets no `PENPOT_TENANT`).
- `backend-tests.helpers` has `metrics-stub` (a metrics instance with no collectors, where every `run!` is a no-op), `init-climit` (a concurrency limiter built from an inline config map, with an optional second argument for the metrics instance to publish to) and `with-climit`, the macro that builds one, runs the body and halts it. `init-climit` starts the republisher daemon thread, so a test that builds a limiter without halting it leaks that thread for the rest of the JVM run: use `with-climit`. Log lines are capturable with `add-watch` on `app.common.logging/log-record` (it holds the last record; the watcher sees every one, but only of the levels the logger has enabled: a line the app writes at TRACE never gets there).

1
.serena/memories/clojure/design-rules.md
View File

@ -6,6 +6,7 @@ How to shape a function in this codebase. Each rule came from a review round; do
- **Optional-by-design data is guarded where the optionality is born.** Example: `ConnectorStatistics` is nil when the server option is off, so the guard is `when-let [cs (some-> server ...)]` at the entry point and the consumer assumes `cs`.
- **A static set of operations is written statically.** With a fixed, small set (four metrics) write the four calls. Do not build a collection and iterate it (`doseq` over a literal vector): it allocates, adds indirection and hides each operation. Use a collection when the set is dynamic (config, registry, input).
- **Default to no `!`; existing `!` is legacy being removed gradually.** Do not introduce new `!` names except the allowed cases documented in `mem:clojure/idioms` (add and justify the special case there first). Allowed: mutating public fns in `app.db` (`insert!`, `update!`, `delete!`, `run!`, `tx-run!`, ...) and fns whose contract is to work over transients (stdlib `conj!`/`assoc!`/`dissoc!`/`persistent!` and custom helpers over them). Existing `!` elsewhere (e.g. `emit!`, `send!`, `submit!`, `validate-file!`) stays until its refactor; keep a family consistent in the meantime. Reporting helpers (log, sample-and-publish) never take `!`: the mutation happens in the `!` API they call.
- **`?` marks a predicate, not a data prop.** A var or function that answers a question takes `?` (`export-error?`, `(defn editable? …)`); a map key that names a property does not (`:export-error`, never `:export-error?`), even when its value is a boolean. Existing `?` keys are legacy to remove gradually; do not add a new one.
- **Do not shape production code for tests.** No return values added just to assert them; assert on the observable effect. When preconditions move, move the tests with them.
Reference implementation: the http metrics samplers in `app.http` (`sample-worker-metrics` / `sample-connector-metrics` are guard-free; `sample-http-metrics` guards at the boundary).

13
.serena/memories/common/uri.md Normal file
View File

@ -0,0 +1,13 @@
# Common URI helpers
`app.common.uri` wraps `lambdaisland.uri` and re-exports `join`, `parse`, `query-encode`, `percent-encode` and `uri?` with `dm/export`.
## `join` resolves references, it does NOT concatenate paths
- `lambdaisland.uri/join` implements RFC 3986 reference resolution, not path concatenation: a relative reference that does not start with `/` replaces everything after the last `/` of the path it is resolved against. Joining several segments resolves them successively, so each segment replaces the last segment of the previous result.
- `(join "https://h/" "api/teams/" "<id>" "users/" "<pid>")` returns `https://h/api/teams/users/<pid>`, not `.../api/teams/<id>/users/<pid>`: `"users/"` replaced `"<id>"`. `(apply join base segments)` behaves the same.
- `ensure-path-slash` normalizes only the BASE to end with `/`; it does not touch the segments, so a base ending in `/` is not enough for a multi-segment append.
- To append several segments: either join them into a single relative path first (dropping empty segments and collapsing slashes), or make every non-final segment end with `/`, including the dynamic ids. Keep that normalization in the shared URL builder, not in each call site.
- A segment starting with `/` resolves against the host root and silently drops the base subpath; reject it.
- Frontend `app.config` normalizes the base (`normalize-uri`) and relies on callers passing trailing-slash segments by convention (`resolve-file-media` joins `"assets/by-file-media-id/"` then `"<id>/thumbnail"`); it does not normalize segments.
- Backend shared builders are `app.config/join-uri` and `app.config/get-public-uri`. A past refactor moved Nitrate's per-request helper onto them without the segment normalization and broke every multi-segment Nitrate URL that passes `"api/teams/" team-id "users/" profile-id`.

2
.serena/memories/critical-info.md
View File

@ -55,6 +55,8 @@ The memory is structured in a way that you can get the critical information abou
- `scripts/psql` — PostgreSQL client wrapper with devenv defaults. Companion: `scripts/db-schema` for DDL dumps. See `mem:scripts/psql`.
- `scripts/taiga.py` — Fetch public issues, user stories, and tasks from the Penpot Taiga project without authentication. See `mem:scripts/taiga`.
- `scripts/gh.py` — GitHub operations helper: list milestone issues, fetch PR details, compare against CHANGES.md. Requires `gh` CLI. See `mem:scripts/gh`.
- `scripts/project-anomalies.py` — Main-board anomaly check for a milestone (`check` writes `tmp/<MILESTONE>-ANOMALIES.md`). Bulk resolution via `scripts/gh.py`. See `mem:scripts/project-anomalies`.
- `scripts/changelog.py` — Changelog checks for the `update-changelog` skill: `check-merged` (PR merge status), `cross-ref` (milestone PRs vs changelog section), `report` (anomaly report to CHANGES-ISSUES.md). Calls `scripts/gh.py` via subprocess. See `mem:scripts/changelog`.
- `scripts/error-reports.mjs` — Query error reports via RPC API with token authentication. Supports list/get operations with filtering and pagination. See `mem:scripts/error-reports`.
- `scripts/clean-node-modules` — Remove stale `node_modules` from all pnpm workspaces (root, modules, member packages). Keeps the shared pnpm store at `<repo>/.pnpm-store` unless `--store`; ignores `external/` and `.opencode/`. Usage and reinstall steps: `mem:workflow/updating-pnpm`.
- `scripts/ci` — CI orchestration script: runs lint, tests, and format checks per module (`frontend backend common render-wasm exporter mcp plugins library`). Logs go to `.ci-logs/`; read the log file on failure. It is the preferred way to run the backend tests, and it exports `PENPOT_FLAGS` with `enable-backend-asserts`, which is what makes `clojure.core/assert` exist in the compiled test code. See `mem:scripts/ci`.

2
.serena/memories/frontend/dashboard-viewer-subtleties.md
View File

@ -5,10 +5,12 @@
- Dashboard initialization fetches projects and fonts for the team, then listens to websocket messages only for global topic `uuid/zero` or the current profile id.
- Project fetch replaces each project map completely instead of merging, so fields such as `deleted-at` can disappear cleanly.
- Dashboard file/project mutations are often optimistic local updates with fire-and-forget RPC watchers. Bulk permanent delete/restore paths use SSE progress and progress notifications.
- The import wizard runs the package as a job of the backend: it reads the manifest of the file in the main thread (`app.main.data.imports`, no web worker) and follows the job, so its rows paint the milestone of the job (the stage and its counter, with the file in course) instead of the messages the old SSE stream sent. Before the job exists, the rows paint a client-side `:upload` milestone built from the chunked upload (`uploads/upload-blob-chunked` `:on-progress`, chunks done/total), which never comes from the backend; the chunks go one at a time and the row writes them as a percentage of the file, not as a counter. Once created and still waiting for a worker, each entry reports `:queued` ("Queued"); the `:start`/`:retry` events move it to bare progress, and only `:progress` carries a milestone. The export modal follows the same one-job-per-file model, but every file is queued up front (even the ones whose job is created only after the previous one is over) and its queue ends only with a milestone: `:start`/`:retry` do not end it there. Neither modal paints a generic "…ing file…" line any more: each row carries its own status. The `:error` of an import entry is user-facing text (the backend hint, or a translated label), never an i18n key: the wizard renders it as-is, it does not translate it again. The legacy SSE import stays in the backend for other clients.
- File creation/duplication strips file `:data` before putting file summaries into dashboard state.
## Viewer
- `app.main.ui.ui` parses the viewer's `file-id` query param with `uuid/parse*`, so a missing or malformed id arrives as nil. `viewer-page*` calls `check-file-id!` (same namespace) during render, before mounting `viewer*`: it raises `ex/raise :type :not-found :code :missing-file-id`, which the error boundary turns into the not-found page. Without the guard the `dv/initialize` assertion fails on the nil file-id and the user gets an internal-error page. Test: `frontend-tests.ui.viewer-test/check-file-id-raises-not-found-for-invalid-file-id`.
- Viewer initialization sets `:current-file-id`, `:current-share-id`, and `:viewer-local`, then fetches the view-only bundle. Comment threads are fetched only for logged-in users.
- Viewer bundle fetch sends the full supported feature set because anonymous shared viewers may not know team-enabled features.
- View-only bundles can contain pointer values in `:pages-index` and file data. Viewer resolves those fragments with `:get-file-fragment` before storing the bundle.

7
.serena/memories/frontend/routing-app-shell-subtleties.md
View File

@ -3,9 +3,13 @@
## Router, app shell, and errors
- Routing uses browser-history query tokens (`?screen=<route-name>&params`, single `/` path), but `on-navigate` rejects navigation if the current origin/path does not match `cf/public-uri`.
- `app.util.browser-history` (CLJS, not the old `goog.history.Html5History` wrapper) is the only history layer: the token is `location.search`, the URL of a token is `(:path cf/public-uri)` + token, and every change (own `pushState`/`replaceState` or back/forward) lands on the `token-changes` subject the router subscribes to. Nothing about it lives in the store: `rt/initialize-history` is effect-only.
- `set-token!` and `replace-token!` are deliberately asymmetric. `set-token!` is a total no-op when the token already is the current one (no URL write, no report), so navigating to the screen you are on cannot grow the history stack. `replace-token!` always writes and always reports, because it is how the app corrects the URL in place (legacy `#/…` translation, cleaned share links) and that correction must reach the router even when the token did not change. This matches `Html5History`, which did the same; do not "fix" the asymmetry without deciding what navigates to the current screen.
- `app.util.dom/replace-history-state!` is the deliberate bypass used by `app.main.ui.dashboard`/`app.main.ui.static` to rewrite the URL **without** routing. Keep using it there instead of `replace-token!`, which would re-enter the router.
- Route params live entirely in the query map under the reserved `screen` key; duplicate query params can become vectors, so use `rt/get-query-param` when a scalar is required.
- Legacy `#/…` hash URLs translate client-side to the query format (one-version compat; see `legacy-routes` in `app.main.ui.routes`, TODO(next-version) to delete).
- Unknown/empty routes trigger an extra `get-profile`/`get-teams` check before redirecting. This avoids invitation and root-route race conditions.
- The root app has two error layers, and they reset differently. `:exception` in the store renders `static/exception-page*` directly and is cleared by `rt/navigated`; a React render error is caught by `app.main.ui.error-boundary` (`react-error-boundary`), whose error lives in internal React state that only `reset-error-boundary` clears. Because every exit from the error page (the logo, the no-permission dialogs, the SSO dialog, the feedback link) only *navigates*, the boundary is given `:resetKeys [(eb/reset-key route)]` — the screen name — so a navigation counts as a fresh attempt at rendering. Three traps in that `resetKeys` value, all learned the hard way: it must be a real JS array (`#js [...]`), never a ClojureScript vector, because `react-error-boundary` reads `.length` and `.some` and a `PersistentVector` has neither, so `componentDidUpdate` throws `some is not a function`; it must hold the screen name as a *string*, because the library compares entries with `Object.is` and ClojureScript does not intern keywords, so two equal keywords are two objects and a keyword key would read as new on every route rebuilt, resetting the boundary on a param change inside the same screen; and it must be the screen rather than the params, so a param change does not replay the screen that just crashed. Navigating to the *same* screen therefore does not reset, and a reload is the only way out of that case.
- The root app renders an exception page from `:exception` state before the normal error boundary. `rt/navigated` clears `:exception`.
- Frontend error handling treats stale cross-build JS chunk failures specially: messages containing `$cljs$cst$` or `$cljs$core$I` plus undefined/null/not-a-function signatures trigger throttled reload.
- Plugin-originated uncaught errors are identified through the plugin runtime hook and logged rather than turning into the global exception page.
@ -19,4 +23,5 @@
For general store mechanics such as `emit!`, `last-events`, persistence, and undo, read `mem:frontend/workspace-state-persistence-subtleties`.
- Websocket initialization uses `cf/public-uri` joined with `ws/notifications`, converting `http/https` to `ws/wss`, and includes the current `session-id` as query param.
- Reinitializing or finalizing websocket stops the previous receive stream. Incoming websocket payloads become Potok data events under `app.main.data.websocket/message`.
- Reinitializing or finalizing websocket stops the previous receive stream. Incoming websocket payloads become Potok data events under `app.main.data.websocket/message`.
- A job the client created is followed with `app.main.data.jobs/watch-job`: it emits the `:job-event` messages of that job (filtered by `:job-id`) and one final outcome read from the row with `get-job`, which is read when the stream starts and again on every `opened` of the websocket, so a job that ended before the client started following it, or while the socket was down, still answers. The stream ends after that outcome, and a read that fails reaches the caller: the repo retries the transient transport errors of a GET, and anything else is a real failure the flow has to show. The `:stage` of a progress event is a stable key of the vocabulary of the worker, never a display string: `app.main.ui.jobs.progress` resolves it with a `case` of literal `tr` calls, falls back to a generic label for a stage it does not know, and the counter of the activity is named after its own stage (the counter of `:files` is the outer context).

26
.serena/memories/frontend/translations.md
View File

@ -7,10 +7,11 @@ high-coverage support reference, never the base.
## Workflow
- Canonicalize with `node ./scripts/translations.js sync -l <locale>` from `frontend/`: sorts entries, syncs `#:` comments from `en`, deletes keys missing in `en`.
- `sync` never ADDS a key missing in the locale: it only syncs comments (for keys that already exist) and drops keys absent from `en`. A key added to `en` alone stays missing in `es` and its text silently falls back to English. Every new key is born in `en` AND `es` in the same change; compare the `msgid` sets to check (`comm -23 <(grep '^msgid ' en.po | sort -u) <(grep '^msgid ' es.po | sort -u)` must be empty).
- `sync` copies ALL comment flags from `en`, including `#, fuzzy`. Translated entries must NOT stay fuzzy: strip the flag after translating (mirror `es.po`, which keeps fuzzy only on genuinely untranslated entries). Fuzzy entries are excluded from `msgfmt --statistics` translated counts.
- Canonical files carry NO `#~` obsolete blocks (`en`/`es` have zero). Drop them; `sync` does not resurrect them.
- Definition of done: `msgfmt --check <locale>.po` exit 0 and `msgfmt --statistics` shows 0 fuzzy, 0 untranslated.
- `rehash` scans `frontend/src` AND `common/src` for `(tr "key"` occurrences (any line counts, including `;;` comments) and refreshes `#:` refs in `en`, marking unreferenced keys `#, unused`.
- Definition of done: `msgfmt --check <locale>.po` exit 0, `msgfmt --statistics` shows 0 fuzzy, 0 untranslated, and the locale's `msgid` set is identical to `en.po`'s (no key missing, none extra).
- `rehash` scans `frontend/src` AND `common/src` for `(tr "key"` occurrences (any line counts, including `;;` comments) and refreshes `#:` refs in `en`, marking unreferenced keys `#, unused`. The refs in `en` are broadly stale, so a repo-wide `rehash` rewrites hundreds of lines (measured: ~487 on `en` alone): it is a maintenance action on its own, never a step to run inside a change that only adds or edits a key.
- Dynamic keys are invisible to `rehash`: eliminate them instead of
declaring them. Preference order: literal `(tr "key")` args only;
never put a branch inside `tr`, hoist it out (`(if cond (tr "a") (tr "b"))`);
@ -28,6 +29,12 @@ high-coverage support reference, never the base.
## Entry rules
- Placement: a key names the feature that renders it (`dashboard.import.*`,
`files-export-modal.*`, `jobs.*`); `labels.*` is the bucket for the short
generic words reused across screens (Accept, Cancel, Download…), never the
home of a feature's own vocabulary. Keep a feature's strings together: the
durable jobs write their progress stages as `jobs.progress.stage.*` and
their row statuses as `jobs.*`, not half in `labels.*`.
- Keys resolved dynamically from server-provided data carry a `#, backend`
flag (set it in `en`, `sync` copies it to the locales): do not remove or
rename these entries, and keep their `%s` placeholders (the backend only
@ -40,7 +47,6 @@ high-coverage support reference, never the base.
- Preserve verbatim: `%s`/`%d`, `{var}`/`{{...}}`, markdown `[text](%s)`, HTML tags, `\n` positions, brand names (Penpot), key names (Ctrl/Shift/Alt), technical terms (SVG, CSS, HSV, RGB).
## Catalan (ca) conventions
- Normative IEC/Termcat Catalan. Address the user in VOSALTRES (2nd person plural): "Deseu", "Creeu", "Ja teniu un compte?". Buttons/menus use short imperatives ("Crea", "Mou", "Restaura").
- Established glossary (reuse exactly, do not re-coin): layer=capa, board=tauler, stroke=traç, fill=Emplenat, blur=Difuminat, shadow=Ombra, clipboard=porta-retalls, delete=Elimina, rename=Canvia el nom, shortcut=drecera, grid=graella (keep "grid" where the file already does, e.g. grid-layout editing), plugins/extensions UI=extensions, layout=Disposició, gradient=Degradat, wireframing kept as loanword.
- Ela geminada uses the middle dot: Cancel·la, paral·lel, al·lega.
@ -48,6 +54,20 @@ high-coverage support reference, never the base.
- Shortcut/action names (`shortcuts.*`) are noun/infinitive labels, not sentences. Error strings are direct, no hedging.
- Same English source in different contexts may legitimately differ (verb "Copia" vs noun "Còpia"; "Desactivat" vs "Deshabilitada" agreeing with "drecera"). Normalize only true duplicates.
## Russian (ru) conventions
- Formal address with capital ВЫ ("Вы уверены…", "Вы собираетесь…"). Buttons/menus use infinitives ("Создать", "Удалить", "Дублировать"), never imperatives.
- Established glossary (reuse exactly, do not re-coin): layer=слой, board=доска (EN `board` is NEVER кадр — normalized in lote1: toolbar/viewer/shape-menu/header-menu/export-frames/undo/num-of-frames), path/draw tool=контур, stroke=обводка, fill=заливка, blur=размытие, shadow=тень, grid=сетка, clipboard=буфер обмена, shortcuts=сочетания клавиш (normalized in lote1: title/show-shortcuts/not-found), plugin=плагин, layout=макет (`labels.layout` fixed in lote1), gradient=градиент, token=токен, set=набор, theme=тема, file=файл, project=проект, team=команда, library=библиотека, component=компонент.
- No external RU style guide applies verbatim (Mozilla ru guide is marketing-only, GNOME glossary unmaintained, Adobe uses монтажная область for artboard but `ru.po` majority already says доска — keep доска for consistency).
- `words.ru.txt` `[function]` DELIBERATELY omits 1-letter words (в/с/к/о/у/а/и) and ending-colliding particles (на/по/не/ли/же/бы/его/их/те/или…): Russian inflects (проект→проекта, запросили=запрос+или), so listing them flags every inflected noun/verb. Never "complete" that list; put tripped valid words in `[ok]`.
- Never abbreviate т. д. / т. е. in `ru.po`: the lone т/д tokens poison the glue detector's frequency map and flag short words (тон→т+он). Write и так далее out.
- Tokens-domain glossary (lote2, reuse): alias=алиас, remap=переназначить, viewport=вьюпорт, set=набор, theme=тема, spread (shadow)=распространение, margins=внешние отступы, paddings=внутренние отступы, gaps=промежутки, type identifiers stay in English (Line Height, Font Size, innerShadow/dropShadow, none/Uppercase/Lowercase/Capitalize, thin/light/regular/bold/Italic).
- Editor-domain glossary (lote3, reuse): variant=вариант, property=свойство, guide=направляющая, board guide=направляющая доски, MCP server=MCP-сервер, size preset=пресет размера, border-radius section=скругление, path handler=маркер, canvas=холст, render=рендер/рендеринг, plugin (never extensión)=плагин.
- Avoid standalone те (those) in phrasing ("те же" → "такие же"): one lone те validates те+мы splits and flags every темы. Same poisoning class as т. д.
- `words.ru.txt` `[function]` also omits пока (dropped in lote4): with standalone за anywhere in the file, пока+за flags показа. Rare-typo detection loss accepted.
- Billing-domain glossary (lote4, reuse): plan names follow shipped `ru.po`, NOT es: Enterprise=Корпоративный, Professional=Профессиональный, Unlimited=Безлимитный, trial=пробный; subscription=подписка, storage=хранилище, seat editors=редакторы, viewer role=наблюдатель, amounts as `175 $/мес.` / `10 ГБ`; access token=токен доступа, MCP key=MCP-ключ (regenerate=перевыпустить), markdown `[text|target:self](%s)` kept verbatim.
- Closing-domain glossary (lote5, reuse): shortcut noun everywhere=сочетание (shortcuts section titles are noun/infinitive labels, never ярлыки); node=узел, segment=сегмент, measurements=размеры; WebGL unavailable flow uses гайд/руководство по неполадкам + рендеринг WebGL выключен/включён; `ru.po` reached 2275/2275 keys (100%) with 0 fuzzy, 0 untranslated per `msgfmt --statistics`.
## QA before commit
- Run `node ./scripts/translations.js check -l <locale>` from `frontend/` (no default locale: pass `-l` explicitly): 0 errors required; review warnings by hand. Word lists live in `frontend/scripts/check-translations/words.<locale>.txt` (`[elision]` `[function]` `[common]` `[ok]` `[brands]`); new valid words that trip the gate go to `[ok]`; `check --self-test` covers the detector rules. Without a catalog only the universal checks run. `#, fuzzy` entries are skipped (known-pending, owned elsewhere).

15
.serena/memories/mcp/core.md
View File

@ -85,6 +85,21 @@ From the `mcp/` directory, run
* `pnpm run build` to test the build of all packages
* `pnpm run fmt` to apply the auto-formatter
* `pnpm run test` runs the tests of `plugin` (node test runner) and `server` (tsx).
The committed `typescript` version is 6.x: the 7.x line ships only a version stub
at the `typescript` entry point, and its synchronous compiler API is gone, so
`ts.transpileModule` (used by the plugin tests to compile `main.ts`/`plugin.ts`
into a sandboxed browser-like context) fails there.
* `packages/server` type-checks against the built `dist` of `@penpot/mcp-common`;
a stale `packages/common/dist` makes `types:check` fail with missing exports
(e.g. `PenpotSession`). Run `pnpm --filter mcp-common run build` first.
* The server logger (`packages/server/src/logger.ts`) uses pino transports only
outside `node:test` (`logTransportTargets`). A transport spawns a worker thread
whose message port stays referenced once a line is in flight, so the test child
process keeps running after the tests finish and the suite hangs intermittently
(node reports `Promise resolution is still pending but the event loop has
already resolved` for the file's root test). Inside tests the logger writes to
stdout directly. `NODE_TEST_CONTEXT` is the env var `node --test` sets.
* Cross-cutting testing principles and anti-patterns: `mem:testing`.
## Devenv plugin/server wiring

2
.serena/memories/plugins/core.md
View File

@ -26,7 +26,7 @@
## Lifecycle
- Loading a plugin closes existing non-background plugins and resets the runtime registry. Be careful around `allowBackground` semantics when changing load/close behavior.
- Loading a plugin closes existing non-background plugins and removes them from the runtime registry. Background plugins (`allowBackground`) keep running and must stay registered: the registry routes their UI `postMessage` traffic by sender iframe and is what `ɵunloadPlugin` searches.
- If sandbox evaluation fails, the runtime marks the error as plugin-originated, closes the plugin, and rethrows.
- `plugin-manager` removes event listeners, timers, intervals, and modal state on close, and marks the plugin destroyed. Listener callbacks check that flag because Penpot events can fire after close.

18
.serena/memories/prod-infra/core.md
View File

@ -12,9 +12,9 @@ Backend (`app.config`, `PENPOT_*` env vars) is parameterized; deployments choose
## Task queue and worker model
Async jobs are enqueued via `jobs/submit` (`app.jobs`), which inserts a row into the shared Postgres `job` table tagged with `queue = "<tenant>:<queue-name>"`. Submission is **fire-and-forget** — RPC handlers never poll and never wait. The completion signal is the `job` row's `status` / `completed_at` columns, which nothing in `rpc/` reads today. A job submitted with `::jobs/profile-id` also publishes a `:job-event` message on that profile's msgbus topic after each transaction commits, but no caller passes a profile-id yet, so nothing reaches msgbus in production. Soft-delete RPCs return immediately after marking the top-level row, leaving the cascade and reaping to workers.
Async jobs are enqueued via `jobs/submit` (`app.jobs`), which inserts a row into the shared Postgres `job` table tagged with `queue = "<tenant>:<queue-name>"`. Submission is **fire-and-forget** — RPC handlers never poll and never wait. The completion signal is the `job` row's `status` / `completed_at` columns, which the creation commands read back to answer with the state of the job they just created. A job submitted with `::jobs/profile-id` also publishes a `:job-event` message on that profile's msgbus topic after each transaction commits, and the binfile commands (`create-export-binfile-job`, `create-import-binfile-job`) are the callers that pass that owner, so the progress of their jobs does reach the msgbus. Soft-delete RPCs return immediately after marking the top-level row, leaving the cascade and reaping to workers.
Workers run on backends with `enable-backend-worker` in `PENPOT_FLAGS`. Each worker-enabled backend has a `dispatcher` (polls `job` with `FOR UPDATE SKIP LOCKED`, marks status='scheduled', RPUSHes the JSON `[id scheduled-at]` payloads into **its own** Redis list) and one or more `runner`s per queue (BLPOP from that same local list, execute, update the Postgres row). The Redis hand-off list is purely intra-backend — cross-backend coordination happens at the Postgres row level.
Workers run on backends with `enable-backend-worker` in `PENPOT_FLAGS`. Each worker-enabled backend has a `dispatcher` (polls `job` with `FOR UPDATE SKIP LOCKED`, marks status='scheduled', RPUSHes the JSON `[id scheduled-at]` payloads into **its own** Redis list) and one or more `runner`s per queue (BLPOP from that same local list, execute, update the Postgres row). The Redis hand-off list is purely intra-backend — cross-backend coordination happens at the Postgres row level. The queues are `default`, `webhooks`, `cron` and `binfile`: the last one carries the heavy work of a user job (`:worker-binfile-parallelism`, default 1), so a long export or import does not block the default runner.
## Cross-backend safety
@ -31,8 +31,22 @@ Penpot in production lives with both: horizontal-scale deployments accept "exact
Worker-enabled, writable backends publish unified jobs metrics through the normal Prometheus registry. Counters describe submit, dispatch, terminal outcomes, retries, orphan recovery, rescheduling and total stored job events (unlabelled); histograms separate queue wait, handler execution and total job age. SQL-backed events are recorded after the outer PostgreSQL transaction commits. The `::jobs-metrics/sampler` component publishes backlog by status and the oldest pending-job age every 30 seconds. All labels are bounded operational values; job IDs, profile IDs, params and error text are excluded. Read-only backends do not start the sampler or the workers.
## Draining one instance
Each backend has a per-process availability flag (`app.health`, a global atom). While offline, `/readyz` answers `503 OFFLINE` without querying the database, so the load balancer removes that instance from rotation while requests in flight still finish. Operator surface: `app.srepl.main/set-offline` / `set-online`; a restart comes back online. In-flight worker jobs are safe: jobs claimed as `scheduled` return to `new` after 5 minutes via `sql:reschedule-lost` and another instance picks them up.
## Touching production data
Production runs the deployed toolbox, not the devenv one:
- **No psql meta-commands there.** `scripts/psql` and `\set`, `\if`, `\copy` do not exist in production, so a data script must be **plain SQL**, copy-pasteable into any client.
- **Start from the ids, not from an inventory.** The ids come from the error or the logs. Unbounded queries over tables with tens of millions of rows (`storage_object`, `file_media_object`) do not finish in a reasonable time; bounded to an id list they are index lookups.
- **One query per reference column.** Two columns in one `IN (col_a, col_b)` lose the index and scan the whole table; split them.
- The read-only replica cuts long queries: see `mem:prod-infra/grafana`.
## See also
- Devenv composition and the ws0-only worker placement: `mem:devenv/core`.
- Storage backend resolution, dedup, bucket behavior, object lifecycle, and file-data lifecycle: `mem:backend/storage`.
- Storage operation metrics (S3 API calls, logical ops, dedup, asset requests) and the logical-bucket vs physical-target distinction: `mem:backend/storage` (Metrics section).
- Grafana (datasource ids and how to use them, main dashboard, panel conventions and gotchas): `mem:prod-infra/grafana`.

42
.serena/memories/prod-infra/grafana.md Normal file
View File

@ -0,0 +1,42 @@
# Grafana
Private instance with Penpot metrics and logs. Dashboards are edited through the Grafana API (MCP tools); there is no dashboards-as-code for them.
Keep this memory free of internal names: no host names, no deployed versions, no topology. The datasource ids and the label conventions are the useful technical part.
## Datasources
- Metrics — **Prometheus**, uid `xkRmyFBGk`. PromQL. Metric families: `penpot_*` (RPC, task timings, CLIMIT, HTTP, websocket, storage), `hikaricp_*`, `jvm_*` and `process_*` on the backend (`job="app"`); `pg_*` from the Postgres exporter (`job="postgres"`); `redis_*` from the Redis exporter (`job="redis"`); `node_*` and `container_*` from node-exporter and cAdvisor. Backend histograms are in **milliseconds**.
- Logs — **Loki**, uid `h3CGKhEMk`. LogQL, and filter by the structured metadata `logger`/`level` (`{job="penpot"} | logger="..." | level="ERROR"`). Signals that only exist as logs: the profile behind a CLIMIT queue (`logger="app.rpc.climit"`, whose `id` carries the key). CLIMIT rejections have their own counters (`penpot_rpc_climit_rejected_total`, by `name` and `reason`), and their `hint="rejected"` line goes out at WARN only when something stays queued, so counting the lines is not counting the rejections.
- SQL — **Postgres**, uid `y8ea9tfMk`. Panels need `rawQuery: true`, `editorMode: "code"` and `format: "table"`. The `task` table is the only truth about the queue depth. It is a **read-only replica**: it rejects any write, `CREATE TEMP TABLE` included, so queries through it must be plain `SELECT`s. It also cuts long-running queries (the MCP path has a short timeout), so bound them (e.g. a list of ids); an empty answer there is not proof that there is no data.
- **Postgres (telemetry)**, uid `9YAUuM_Gz`.
- `$__rate_interval` and `$__interval` are substituted by Grafana; use them instead of fixed windows in graphs.
## Main dashboard
- `Production status`, uid `penpot-production-status`. Sections: general state and deploy, RPC and CLIMIT, PostgreSQL and pool, Redis/msgbus, tasks, JVM/process. Variables `$env` and `$host` (custom), no auto refresh.
- Per-host investigation dashboards are separate, and the alert rules deeplink into them.
## Conventions
- Filter with `instance=~"$host.$env.<domain>.*"`. To know which instances serve, count the ones reporting JVM metrics; `up{job="app"}` is not reliable (it can report 1 while the endpoint answers an empty body).
- Layout: a band of number-only panels at the top of each section, wider data panels below, tables tall enough to show every row, legend on the **right** sorted by last value descending (`sortBy: "Last *"`, `sortDesc: true`).
- Panels comparing used against total need `defaults.min = 0`, else the automatic axis exaggerates the difference.
- Counters per method or task name read better as `increase(...[1h])` than `rate(...)`, with `decimals: 0`.
- Cron "did it run" comes from the task metrics, not from the cron registry table (it keeps rows from old versions).
- Dashboard thresholds must match the alert rule thresholds.
## Gotchas
- PromQL literal dots need `\\.`; simpler to use `[.]` or a plain dot.
- The panel-level `datasource` must match its targets'. A SQL table declared as Prometheus renders empty even though the query returns rows.
- Shortening a host in a legend needs a short label in the query: `renameByRegex` renames the field name, but with `legendFormat` set the legend text comes from the datasource.
- Prometheus: `label_replace(<expr>, "host", "$1", "instance", "([^.]+)[.][^.]+.*")` plus `legendFormat: "... {{host}}"`.
- Loki metric query: `| label_format host="{{ regexReplaceAll "[.][^.]*[.][^.]*[.][^.]*$" .instance "" }}"` plus `legendFormat: "{{host}}"`. Quotes inside the template must be escaped as `\"`, or LogQL closes the string early (`not a valid duration string`).
- Tables from a Prometheus raw selector carry a `__name__` column; hide it with `organize`.
- Saving through the API normalizes the dashboard (rows may be flattened, `y` recomputed): submit the native form (rows with `panels: []`, panels top-level, contiguous `y`).
- Panel images cannot be rendered (no image renderer installed) and there is no browser here: verify a dashboard by running its queries with the variables substituted.
- Signals that exist only as logs are counted with Loki, and the count is then cross-checked against the nginx access log for the same window and the same status code (`job="frontend"`, e.g. a `429`): two independent sources must agree before a number is trusted.
- The app writes its own logs at WARN only when something is left queued behind the call and at TRACE otherwise, so production Loki holds just the under-pressure lines: a count of `hint="enqueued"` or `hint="acquired"` is not the number of calls, and neither is a count of `hint="rejected"` lines, because a rejection that leaves the queue empty (a lone caller that times out) is written at TRACE. The rejection counters are the real number.
- The MCP Prometheus tool can answer empty for every query, `up` included, while the datasource itself is fine: an empty result from it is not proof that a panel has no data, and blaming the datasource for it is wrong. Run PromQL by hand with `grafana_api_request` against `/api/datasources/uid/<uid>/resources/api/v1/query?query=...` (or `POST /api/ds/query`, the path dashboards use), and check when a series is expected but the tool says nothing.
- **Check `list_dashboard_versions` before writing.** The user edits dashboards by hand and a full-JSON overwrite silently reverts that work; prefer `operations` patches per panel.

18
.serena/memories/scripts/changelog.md Normal file
View File

@ -0,0 +1,18 @@
# Changelog helper
`scripts/changelog.py` holds the checks used by the `update-changelog` skill (extracted from the skill file so the skill stays workflow-only). Calls `scripts/gh.py` via subprocess; never call the GitHub API directly from this script.
## Subcommands
- `check-merged <PR...>` (`--file`, `--stdin` accepted) — warn on any non-merged PR, exit 1 when found; run before writing changelog entries.
- `cross-ref <MILESTONE> [--changes CHANGES.md]` — fetch milestone PRs with `--state all` once, report merged PRs missing from the version section plus CLOSED (unmerged) warnings; GHSA entries never appear here by design.
- `report <MILESTONE> [--changes CHANGES.md --output CHANGES-ISSUES.md]` — overwrite the anomaly report (milestone mismatches type A/B plus `:rocket:` gaps C/D); rule violations never belong in the report, they are fixed in CHANGES.md first.
## Conventions
- Milestone resolution is batched, never per-item: unknown PRs go through `gh.py prs <numbers>` and unknown issues through `gh.py issue <numbers>` (one GraphQL call per 50 items); a lookup miss resolves to null, never to an extra call.
- Version-section lookup accepts an optional `(suffix)` after the version header (e.g. `(Unreleased)`); a missing section is an error for `cross-ref` and an empty section for `report`.
- PR/issue reference parsing covers standard `[#N](.../pull/N)` / `[#N](.../issues/N)` links plus legacy `PR:[N]` / `[Github #N]` forms.
- Shared parsing helpers (`extract_version_section`, `extract_subsection`, `collect_changelog_prs/issues`) live at module top so future subcommands reuse them instead of duplicating regexes.
- Report anomaly types: A/B milestone mismatches, E `:boom:` entry whose issue lacks the `breaking change` label (counted, entries preserved — human labels the issue or moves the entry); C/D are `:rocket:` gaps (warnings, never counted).

3
.serena/memories/scripts/ci.md
View File

@ -61,6 +61,9 @@ Flags:
- `mcp` has no lint task (shows as skipped). `render-wasm` uses `./lint`,
`./test`, and `cargo fmt`.
- Exports `PENPOT_FLAGS` with `enable-backend-asserts` appended to any
existing value, so backend test runs compile in and exercise
precondition asserts; see `mem:backend/testing`.
- Test tasks are long-running (backend: `clojure -M:dev:test`); use a
generous timeout when calling it from an agent shell.
- Skill entry point: `.agents/skills/local-ci/SKILL.md`.

13
.serena/memories/scripts/gh.md
View File

@ -49,11 +49,13 @@ python3 scripts/gh.py issues "2.16.0" --compare CHANGES.md
- Issues with type "Task" are excluded (`--include-tasks` to keep them).
- Issues with "Rejected" project status are excluded (`--include-rejected` to keep them).
Every issue entry carries `assignees` (logins) and `projects` (board titles); every PR entry carries `assignees`.
**Output**: JSON array to stdout; progress to stderr.
### `prs`
Fetch PR details by number or by milestone.
Fetch PR details by number or by milestone. Every entry includes a `milestone` field (title or null).
```bash
# Fetch specific PRs
@ -74,6 +76,12 @@ python3 scripts/gh.py prs --milestone "2.16.0" --state all
**Output**: JSON array to stdout; progress to stderr.
### `issue`
Fetch issue details by number in batches of 50 (same input styles as `prs`: numbers, `--file`, `--stdin`). No filters. A dead number fails its whole batch (unlike PRs, issues error instead of resolving to null), so the batch falls back to one-by-one lookups and reports misses as `{"number", "error": "not_found"}`. Any other failure aborts.
**Output**: JSON array to stdout; progress to stderr.
### `link-issue`
Explicitly assign a GitHub issue to a pull request:
@ -111,7 +119,10 @@ python3 scripts/gh.py advisories GHSA-xvj6-fh9w-gjw7
## Key principles
- Changelog-specific checks (merge-status verification, milestone-vs-changelog cross-reference, anomaly report) live in `scripts/changelog.py`, which calls this script via subprocess — see `mem:scripts/changelog`.
- All output is JSON — pipe into `jq` or other tools for further processing.
- Transient HTTP 504 responses from `gh` are retried automatically (3 attempts, 5s/15s backoff); any other error fails fast with no retry.
- Milestone lookup is by exact title match.
- `issues` subcommand auto-paginates (100 items per page).
- `prs` subcommand batches PR number lookups (50 per GraphQL query).

17
.serena/memories/scripts/project-anomalies.md Normal file
View File

@ -0,0 +1,17 @@
# Project anomalies helper
`scripts/project-anomalies.py` implements the `find-project-anomalies` skill: `check <MILESTONE>` fetches milestone issues/PRs with `--state all` via `scripts/gh.py`, resolves outsiders in bulk (one GraphQL call per 50 items), and writes `tmp/<MILESTONE>-ANOMALIES.md` (gitignored scratch output, every number a full GitHub link).
## Anomaly types (all scoped to the milestone)
- Open-with-merged-PR: OPEN issue with a MERGED closing PR (close it or move it out).
- Issue-PR mismatch: milestone issue whose *merged* closing PR is elsewhere/nowhere (an unmerged PR's milestone is irrelevant), or issue off the Main board.
- PR-issue mismatch: *merged* milestone PR closing an issue elsewhere/nowhere (milestone-less issues ARE reported here, unlike the changelog flow), or off the Main board. Unmerged PRs never count anywhere: their milestone is meaningless.
- Needs-triage: MERGED PR on a `needs triage` issue (human triage only, never auto-unlabel).
- Unassigned: MERGED PR on an issue with no assignees and no `community contribution` label on either side (valid states: assigned, or unassigned+community).
## Conventions
- Project membership is checked on the issue side only (`projects` list from `gh.py`); PRs are not the Main-tracked unit, so an unprojected PR alone is never an anomaly.
- Detection (`find_anomalies`) and rendering (`render_report`) are pure functions over pre-resolved dicts; outsiders must be merged into the lookup maps first (missing numbers are skipped, never flagged).
- The only mechanical fix is assigning a missing milestone (`gh pr/issue edit --milestone`); everything else is human judgment with per-item confirmation.

10
.serena/memories/workflow/creating-issues.md
View File

@ -263,6 +263,16 @@ AUTHOR=$(gh pr view <PR_NUMBER> --repo penpot/penpot --json author --jq '.author
gh issue edit <ISSUE_NUMBER> --repo penpot/penpot --add-assignee "$AUTHOR"
```
GitHub only allows assigning users with write permission, org members, or
users who have already commented on the issue. Assigning an outside
contributor fails with `422 ... assignees ... invalid`, and `gh issue edit`
still exits 0 and prints the issue URL. Verify the result and, when the list
stays empty, skip the assignment:
```bash
gh api repos/penpot/penpot/issues/<ISSUE_NUMBER> --jq '[.assignees[].login]'
```
### Set Issue Type and verify
See the **Setting the Issue Type** and **Verification** sections above — the

129
CHANGES.md
View File

@ -6,12 +6,12 @@
- Add configurable keyboard shortcuts [#9924](https://github.com/penpot/penpot/issues/9924) (PR: [#10237](https://github.com/penpot/penpot/pull/10237))
- Improve path operations and edition in the path editor [#10889](https://github.com/penpot/penpot/issues/10889) (PR: [#10807](https://github.com/penpot/penpot/pull/10807))
- Add auto-linking of libraries during import based on slugified name [#9263](https://github.com/penpot/penpot/issues/9263) (PR: [#9958](https://github.com/penpot/penpot/pull/9958))
- Add individual stroke widths per side (top, right, bottom, left) [#9854](https://github.com/penpot/penpot/issues/9854) (PR: [#10648](https://github.com/penpot/penpot/pull/10648))
- Add support for internal libraries and file sync for Design Tokens [#9334](https://github.com/penpot/penpot/issues/9334) (PR: [#10293](https://github.com/penpot/penpot/pull/10293))
### :bug: Bugs fixed
- Fix copying text from Penpot to the clipboard not working on MS Windows [#11303](https://github.com/penpot/penpot/issues/11303) (PR: [#11305](https://github.com/penpot/penpot/pull/11305))
- Fix performance issue with WebGL render [#11240](https://github.com/penpot/penpot/issues/11240) (PR: [#11259](https://github.com/penpot/penpot/pull/11259))
- Fix comment bubbles rendering on top of workspace dropdown menus [#10283](https://github.com/penpot/penpot/issues/10283) (PR: [#11201](https://github.com/penpot/penpot/pull/11201))
- Fix inconsistent Mixed label in blur options and numeric inputs across 24 locales (by @filipsajdak) [#11148](https://github.com/penpot/penpot/issues/11148) (PR: [#11151](https://github.com/penpot/penpot/pull/11151))
- Fix overlay shifting left when shown with top-center alignment in viewer prototype (by @filipsajdak) [#9048](https://github.com/penpot/penpot/issues/9048) (PR: [#10454](https://github.com/penpot/penpot/pull/10454))
@ -21,31 +21,133 @@
- Fix plugin postMessage channel broadcasting messages to all plugins without origin validation [#10968](https://github.com/penpot/penpot/issues/10968) (PR: [#10970](https://github.com/penpot/penpot/pull/10970))
- Fix MCP plugin page navigation while connected crashing the workspace (by @makesomethingshit) [#11001](https://github.com/penpot/penpot/issues/11001) (PR: [#11521](https://github.com/penpot/penpot/pull/11521))
- Fix shortcut search never matching on key combination, only on action label [#11003](https://github.com/penpot/penpot/issues/11003) (PR: [#11081](https://github.com/penpot/penpot/pull/11081))
- Fix Shift + special character key shortcut capturing the shifted character instead of the physical key [#11004](https://github.com/penpot/penpot/issues/11004) (PR: [#11081](https://github.com/penpot/penpot/pull/11081))
- Fix Shift + special character key shortcut capturing the shifted character instead of the physical key [#11004](https://github.com/penpot/penpot/issues/11004) (PR: [#11081](https://github.com/penpot/penpot/pull/11081), [#11669](https://github.com/penpot/penpot/pull/11669))
- Fix reassigning the "Paste" shortcut not updating the UI or taking effect in the workspace [#11005](https://github.com/penpot/penpot/issues/11005) (PR: [#11081](https://github.com/penpot/penpot/pull/11081))
- Fix font-size dropdown clipping multi-digit values in Firefox (by @0xTHAC0) [#11008](https://github.com/penpot/penpot/issues/11008) (PR: [#11162](https://github.com/penpot/penpot/pull/11162), [#11500](https://github.com/penpot/penpot/pull/11500))
- Fix exporting shortcuts producing an invalid "toggle-fullscreen" entry that breaks re-import [#11032](https://github.com/penpot/penpot/issues/11032) (PR: [#11081](https://github.com/penpot/penpot/pull/11081))
- Fix plugin API missing permission checks in tokens, shapes, variants, flows, layouts, and user identity [#11137](https://github.com/penpot/penpot/issues/11137) (PR: [#11139](https://github.com/penpot/penpot/pull/11139))
- Fix library summary Redis cache keys omitting the tenant [#11407](https://github.com/penpot/penpot/issues/11407) (PR: [#11408](https://github.com/penpot/penpot/pull/11408))
- Fix active theme name in the inspect tab displaying an id instead of the name [#11437](https://github.com/penpot/penpot/issues/11437) (PR: [#11439](https://github.com/penpot/penpot/pull/11439))
- Fix triple-click not selecting the full line in text editor v3 [#11483](https://github.com/penpot/penpot/issues/11483) (PR: [#11493](https://github.com/penpot/penpot/pull/11493))
- Fix pasted text losing formatting on last lines after resizing and adding new lines from the top [#11501](https://github.com/penpot/penpot/issues/11501) (PR: [#11503](https://github.com/penpot/penpot/pull/11503))
- Fix variant property dropdown appearing empty and throwing an internal error when the component has no sibling variants [#11524](https://github.com/penpot/penpot/issues/11524) (PR: [#11499](https://github.com/penpot/penpot/pull/11499))
- Fix invitation links not allowing registration when `disable-registration` is enabled [#5178](https://github.com/penpot/penpot/issues/5178) (PR: [#11912](https://github.com/penpot/penpot/pull/11912))
- Fix Windows build failures caused by path resolution and start command conflicts (by @0xTHAC0) [#8637](https://github.com/penpot/penpot/issues/8637) (PR: [#11197](https://github.com/penpot/penpot/pull/11197))
- Fix editing a path on an image, rectangle or ellipse corrupting the shape and failing backend validation [#10621](https://github.com/penpot/penpot/issues/10621) (PR: [#10807](https://github.com/penpot/penpot/pull/10807))
- Fix board content disappearing when dragging a board near another board [#10689](https://github.com/penpot/penpot/issues/10689) (PR: [#11620](https://github.com/penpot/penpot/pull/11620))
- Fix dashboard context menu being cut off for long lists, hiding the bottom options [#10724](https://github.com/penpot/penpot/issues/10724) (PR: [#11511](https://github.com/penpot/penpot/pull/11511))
- Fix moving an element changing its size [#10751](https://github.com/penpot/penpot/issues/10751) (PR: [#11560](https://github.com/penpot/penpot/pull/11560))
- Fix remote MCP websocket connecting but never receiving live browser commands [#10753](https://github.com/penpot/penpot/issues/10753)
- Fix stroke to path not working with path ends (by @ShreyashAgare26) [#10825](https://github.com/penpot/penpot/issues/10825) (PR: [#11614](https://github.com/penpot/penpot/pull/11614))
- Fix border style not working with stroke per side [#10841](https://github.com/penpot/penpot/issues/10841) (PR: [#11883](https://github.com/penpot/penpot/pull/11883))
- Fix multiple selection not showing stroke per side when all shapes share the same per side values [#10844](https://github.com/penpot/penpot/issues/10844) (PR: [#10913](https://github.com/penpot/penpot/pull/10913))
- Fix stroke width tokens not overriding stroke per side values [#10850](https://github.com/penpot/penpot/issues/10850) (PR: [#10913](https://github.com/penpot/penpot/pull/10913))
- Fix internal error when applying a dimension token to stroke width [#10918](https://github.com/penpot/penpot/issues/10918) (PR: [#10913](https://github.com/penpot/penpot/pull/10913))
- Fix stroke per side button detaching the applied token [#10920](https://github.com/penpot/penpot/issues/10920) (PR: [#10913](https://github.com/penpot/penpot/pull/10913))
- Fix WebSocket subscription handlers missing authorization checks [#11067](https://github.com/penpot/penpot/issues/11067) (PR: [#11069](https://github.com/penpot/penpot/pull/11069))
- Fix project title being truncated in the dashboard despite available space [#11306](https://github.com/penpot/penpot/issues/11306) (PR: [#11564](https://github.com/penpot/penpot/pull/11564), [#11675](https://github.com/penpot/penpot/pull/11675))
- Fix `rect` attribute NaN length error in the console when panning a file [#11327](https://github.com/penpot/penpot/issues/11327) (PR: [#11856](https://github.com/penpot/penpot/pull/11856))
- Fix unclipped and rotated shapes being cut on render tiles [#11401](https://github.com/penpot/penpot/issues/11401) (PR: [#11423](https://github.com/penpot/penpot/pull/11423))
- Fix Plugin API rejecting the documented `fontFamilies` applyToken property (by @makesomethingshit) [#11405](https://github.com/penpot/penpot/issues/11405) (PR: [#11566](https://github.com/penpot/penpot/pull/11566))
- Fix flattening text ignoring non-zero letter spacing [#11462](https://github.com/penpot/penpot/issues/11462) (PR: [#11555](https://github.com/penpot/penpot/pull/11555))
- Fix boolean results serialized as unordered subpaths, deforming them in the WebGL render and the exporter [#11482](https://github.com/penpot/penpot/issues/11482) (PR: [#11551](https://github.com/penpot/penpot/pull/11551))
- Fix MCP reconnecting endlessly in inactive tabs and eventually freezing the browser (by @breken-ai) [#11510](https://github.com/penpot/penpot/issues/11510) (PR: [#11520](https://github.com/penpot/penpot/pull/11520), [#11906](https://github.com/penpot/penpot/pull/11906))
- Fix dashed strokes losing their properties when changing color (by @Shlok1729) [#11549](https://github.com/penpot/penpot/issues/11549) (PR: [#11557](https://github.com/penpot/penpot/pull/11557))
- Fix text decoration not applying per text span in the WebGL render [#11582](https://github.com/penpot/penpot/issues/11582) (PR: [#11583](https://github.com/penpot/penpot/pull/11583))
- Fix binfile import exhausting backend memory when a ZIP JSON entry decompresses without limit [#11606](https://github.com/penpot/penpot/issues/11606) (PR: [#11607](https://github.com/penpot/penpot/pull/11607))
- Fix modal not closing when going to the plans page via "See my current plan" (by @makesomethingshit) [#11611](https://github.com/penpot/penpot/issues/11611) (PR: [#11615](https://github.com/penpot/penpot/pull/11615))
- Fix view-only share links disclosing unshared library pages when the file links a library [#11617](https://github.com/penpot/penpot/issues/11617) (PR: [#11627](https://github.com/penpot/penpot/pull/11627))
- Fix canvas tiles showing only the background color while dragging the canvas background color picker [#11642](https://github.com/penpot/penpot/issues/11642) (PR: [#11643](https://github.com/penpot/penpot/pull/11643))
- Fix title spacing and "added" pill padding in the libraries modal [#11645](https://github.com/penpot/penpot/issues/11645) (PR: [#11650](https://github.com/penpot/penpot/pull/11650))
- Fix workspace crash when pasting before the page finishes loading [#11666](https://github.com/penpot/penpot/issues/11666) (PR: [#11674](https://github.com/penpot/penpot/pull/11674))
- Fix tap area not matching the visible screen when zoomed out in the WebGL render (by @makesomethingshit) [#11689](https://github.com/penpot/penpot/issues/11689) (PR: [#11793](https://github.com/penpot/penpot/pull/11793))
- Fix app crash when logging receives an empty level, and add the missing fatal level [#11690](https://github.com/penpot/penpot/issues/11690) (PR: [#11693](https://github.com/penpot/penpot/pull/11693))
- Fix WebGL render ignoring drop and inner shadows on masked groups [#11697](https://github.com/penpot/penpot/issues/11697) (PR: [#11754](https://github.com/penpot/penpot/pull/11754))
- Fix curves being created while Ctrl+dragging a path segment [#11702](https://github.com/penpot/penpot/issues/11702) (PR: [#11715](https://github.com/penpot/penpot/pull/11715))
- Fix viewer role showing the search and replace option [#11706](https://github.com/penpot/penpot/issues/11706) (PR: [#11713](https://github.com/penpot/penpot/pull/11713))
- Fix toggling the visibility of a child in a flex layout main component deleting the prototype interactions of its copies (by @ShreyashAgare26) [#11746](https://github.com/penpot/penpot/issues/11746) (PR: [#11788](https://github.com/penpot/penpot/pull/11788))
- Fix cursor not visible on page load in the WebGL render [#11769](https://github.com/penpot/penpot/issues/11769) (PR: [#11770](https://github.com/penpot/penpot/pull/11770))
- Fix library text styles detaching when copying and pasting an element [#11776](https://github.com/penpot/penpot/issues/11776) (PR: [#11785](https://github.com/penpot/penpot/pull/11785))
- Fix Plugin API crashing the workspace when a shapechange listener is registered with an empty shape id [#11786](https://github.com/penpot/penpot/issues/11786) (PR: [#11787](https://github.com/penpot/penpot/pull/11787))
- Fix borders not being fully rendered [#11805](https://github.com/penpot/penpot/issues/11805) (PR: [#11807](https://github.com/penpot/penpot/pull/11807))
- Fix design token controls being enabled for fills and strokes below the first position [#11819](https://github.com/penpot/penpot/issues/11819) (PR: [#10913](https://github.com/penpot/penpot/pull/10913))
- Fix viewer role showing the open libraries modal button [#11824](https://github.com/penpot/penpot/issues/11824) (PR: [#11849](https://github.com/penpot/penpot/pull/11849))
- Fix extra padding on the "Sets" title in the tokens panel [#11826](https://github.com/penpot/penpot/issues/11826) (PR: [#11849](https://github.com/penpot/penpot/pull/11849))
- Fix thumbnails failing on older Chromium browsers and each thumbnail rendering several times [#11878](https://github.com/penpot/penpot/issues/11878) (PR: [#11879](https://github.com/penpot/penpot/pull/11879))
- Fix internal error when opening the libraries modal [#11943](https://github.com/penpot/penpot/issues/11943) (PR: [#11946](https://github.com/penpot/penpot/pull/11946))
- Fix Plugin API `connectLibrary` linking unpublished files as libraries [#12001](https://github.com/penpot/penpot/issues/12001) (PR: [#12002](https://github.com/penpot/penpot/pull/12002))
### :sparkles: New features & Enhancements
- Make backend storage resilient to interrupted writes, missing files and stalled cleanup [#11344](https://github.com/penpot/penpot/issues/11344) (PR: [#11345](https://github.com/penpot/penpot/pull/11345))
- Implement RTL support in the text editor v3 [#11262](https://github.com/penpot/penpot/issues/11262)
- Improve path operations and edition in the path editor [#10889](https://github.com/penpot/penpot/issues/10889) (PR: [#10807](https://github.com/penpot/penpot/pull/10807))
- Add configurable keyboard shortcuts [#9924](https://github.com/penpot/penpot/issues/9924) (PR: [#10237](https://github.com/penpot/penpot/pull/10237))
- Add auto-linking of libraries during import based on slugified name [#9263](https://github.com/penpot/penpot/issues/9263) (PR: [#9958](https://github.com/penpot/penpot/pull/9958))
- Add support for internal libraries and file sync for Design Tokens [#9334](https://github.com/penpot/penpot/issues/9334)
- Add support for internal libraries and file sync for Design Tokens [#9334](https://github.com/penpot/penpot/issues/9334) (PR: [#10293](https://github.com/penpot/penpot/pull/10293))
- Warn self-hosted users when their Penpot version is outdated and surface what they're missing [#10497](https://github.com/penpot/penpot/issues/10497) (PR: [#11411](https://github.com/penpot/penpot/pull/11411))
- Add dedicated RPC methods for plugin registry operations with permission validation [#10952](https://github.com/penpot/penpot/issues/10952) (PR: [#10957](https://github.com/penpot/penpot/pull/10957))
- Document MCP and internal resolver environment variables (by @ShreyashAgare26) [#11318](https://github.com/penpot/penpot/issues/11318) (PR: [#11572](https://github.com/penpot/penpot/pull/11572))
- Add tokens source indicator to assets tab [#11365](https://github.com/penpot/penpot/issues/11365) (PR: [#11439](https://github.com/penpot/penpot/pull/11439))
- Export multiple fills to SVG [#11466](https://github.com/penpot/penpot/issues/11466) (PR: [#11467](https://github.com/penpot/penpot/pull/11467))
- Add Penpot-specific board size presets (file thumbnail, template cover, plugin icon/cover) [#11561](https://github.com/penpot/penpot/issues/11561) (PR: [#11565](https://github.com/penpot/penpot/pull/11565))
- Apply tokens to stroke per side [#9842](https://github.com/penpot/penpot/issues/9842) (PR: [#10913](https://github.com/penpot/penpot/pull/10913))
- Add individual stroke widths per side (top, right, bottom, left) [#9854](https://github.com/penpot/penpot/issues/9854) (PR: [#10648](https://github.com/penpot/penpot/pull/10648))
- Expand the token tree right after importing it (by @AKnassa) [#9819](https://github.com/penpot/penpot/issues/9819) (PR: [#10664](https://github.com/penpot/penpot/pull/10664))
- Update the selection size badge live during resize, replacing the resize tooltip [#10259](https://github.com/penpot/penpot/issues/10259)
- Add color variants, rotation correction, viewport flip and hide-when-too-small to the selection size badge [#10264](https://github.com/penpot/penpot/issues/10264) (PR: [#11884](https://github.com/penpot/penpot/pull/11884))
- Support single-file SVG export with the WebGL render [#10546](https://github.com/penpot/penpot/issues/10546)
- Persist the hide resolved comments preference and separate the filter options in the comments menu [#10686](https://github.com/penpot/penpot/issues/10686) (PR: [#10694](https://github.com/penpot/penpot/pull/10694))
- Add rich link previews (Open Graph) for shared Penpot links [#10699](https://github.com/penpot/penpot/issues/10699) (PR: [#10700](https://github.com/penpot/penpot/pull/10700))
- Add 3x export scale option [#10740](https://github.com/penpot/penpot/issues/10740) (PR: [#11598](https://github.com/penpot/penpot/pull/11598))
- Show a validation message in the input instead of a toast when the email is already in use (by @ShreyashAgare26) [#10890](https://github.com/penpot/penpot/issues/10890) (PR: [#11647](https://github.com/penpot/penpot/pull/11647))
- Take `waitForLayoutUpdate` into account in MCP instructions and implementation [#10901](https://github.com/penpot/penpot/issues/10901) (PR: [#11433](https://github.com/penpot/penpot/pull/11433))
- Add a standard context menu (Cut, Copy, Paste, Select all) on right-click when editing text [#10914](https://github.com/penpot/penpot/issues/10914) (PR: [#11677](https://github.com/penpot/penpot/pull/11677))
- Process export requests as export jobs [#11133](https://github.com/penpot/penpot/issues/11133) (PR: [#11296](https://github.com/penpot/penpot/pull/11296))
- Enable closed schemas for RPC method parameters [#11135](https://github.com/penpot/penpot/issues/11135) (PR: [#11136](https://github.com/penpot/penpot/pull/11136))
- Add Content-Security-Policy and Strict-Transport-Security headers to the frontend image [#11374](https://github.com/penpot/penpot/issues/11374) (PR: [#11375](https://github.com/penpot/penpot/pull/11375))
- Send a notification email when the password is changed or set [#11392](https://github.com/penpot/penpot/issues/11392) (PR: [#11393](https://github.com/penpot/penpot/pull/11393))
- Lock accounts after repeated failed login attempts [#11397](https://github.com/penpot/penpot/issues/11397) (PR: [#11402](https://github.com/penpot/penpot/pull/11402), [#11895](https://github.com/penpot/penpot/pull/11895))
- Enforce an absolute maximum session duration [#11444](https://github.com/penpot/penpot/issues/11444) (PR: [#11447](https://github.com/penpot/penpot/pull/11447))
- Add a loading message to the libraries section [#11452](https://github.com/penpot/penpot/issues/11452) (PR: [#11594](https://github.com/penpot/penpot/pull/11594))
- Resize image bounds independently from the image content on the canvas [#11516](https://github.com/penpot/penpot/issues/11516) (PR: [#11590](https://github.com/penpot/penpot/pull/11590))
- Limit binfile import database connection time and stop rescanning ZIP entries [#11579](https://github.com/penpot/penpot/issues/11579) (PR: [#11584](https://github.com/penpot/penpot/pull/11584))
- Apply the same validation rules in the Plugin API as in the UI [#11586](https://github.com/penpot/penpot/issues/11586) (PR: [#11587](https://github.com/penpot/penpot/pull/11587))
- Fetch only the caller's share link in the view-only bundle (by @makesomethingshit) [#11633](https://github.com/penpot/penpot/issues/11633) (PR: [#11657](https://github.com/penpot/penpot/pull/11657))
- Add Prometheus metrics for backend storage operations [#11676](https://github.com/penpot/penpot/issues/11676) (PR: [#11700](https://github.com/penpot/penpot/pull/11700))
- Make "Fix when scrolling" work in the WebGL render [#11684](https://github.com/penpot/penpot/issues/11684) (PR: [#11752](https://github.com/penpot/penpot/pull/11752))
- Complete Catalan translations [#11739](https://github.com/penpot/penpot/issues/11739) (PR: [#11741](https://github.com/penpot/penpot/pull/11741))
- Remove the optional client-provided id from creation RPC endpoints [#11783](https://github.com/penpot/penpot/issues/11783) (PR: [#11784](https://github.com/penpot/penpot/pull/11784))
- Allow color tokens for the canvas background [#11791](https://github.com/penpot/penpot/issues/11791) (PR: [#11923](https://github.com/penpot/penpot/pull/11923))
- Show a "no assets yet" message for empty files in the libraries modal [#11811](https://github.com/penpot/penpot/issues/11811) (PR: [#11818](https://github.com/penpot/penpot/pull/11818))
- Upgrade the MCP SDK to v2 and adopt the new protocol version [#11827](https://github.com/penpot/penpot/issues/11827) (PR: [#11841](https://github.com/penpot/penpot/pull/11841))
- Remove legacy SSE support from the MCP server [#11846](https://github.com/penpot/penpot/issues/11846) (PR: [#11841](https://github.com/penpot/penpot/pull/11841))
- Delete selected path handles with Backspace or Delete [#11858](https://github.com/penpot/penpot/issues/11858) (PR: [#11896](https://github.com/penpot/penpot/pull/11896))
- Use the tooltip component in the token pill info [#11886](https://github.com/penpot/penpot/issues/11886) (PR: [#11900](https://github.com/penpot/penpot/pull/11900))
- Hide the duplicate cursor when alt-dragging a shape that cannot be duplicated (by @0xTHAC0) [#11905](https://github.com/penpot/penpot/issues/11905) (PR: [#11195](https://github.com/penpot/penpot/pull/11195))
## 2.18.4
### :bug: Bugs fixed
- Fix storage GC deleting nothing when one pending object is still referenced [#12276](https://github.com/penpot/penpot/issues/12276) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Fix objects GC stopping file deletion when one file still has a child row [#12277](https://github.com/penpot/penpot/issues/12277) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Fix file restore leaving its storage objects marked for deletion [#12278](https://github.com/penpot/penpot/issues/12278) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Fix backend workers staying parked forever when nested calls take the same concurrency limits [#12279](https://github.com/penpot/penpot/issues/12279) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Fix one profile's activity blocking the audit events of every other profile [#12280](https://github.com/penpot/penpot/issues/12280) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
### :sparkles: New features & Enhancements
- Add a graceful instance drain through the /readyz endpoint [#12281](https://github.com/penpot/penpot/issues/12281) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Add an accumulated queue gauge to the CLIMIT metrics [#12282](https://github.com/penpot/penpot/issues/12282) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
## 2.18.3
### :bug: Bugs fixed
- Fix binfile import storing unsanitized SVG and missing obfuscated SVG content-types [#12104](https://github.com/penpot/penpot/issues/12104) (PR: [#12105](https://github.com/penpot/penpot/pull/12105))
- Fix removed team members keeping file access after leaving the team [#12106](https://github.com/penpot/penpot/issues/12106) (PR: [#12097](https://github.com/penpot/penpot/pull/12097))
## 2.18.2
### :bug: Bugs fixed
- Fix workspace showing an internal error when syncing components or dragging in the color picker [#11933](https://github.com/penpot/penpot/issues/11933) (PR: [#11941](https://github.com/penpot/penpot/pull/11941))
- Fix SVG sanitizer keeping namespace-prefixed script elements when uploading SVG files [#12071](https://github.com/penpot/penpot/issues/12071) (PR: [#12073](https://github.com/penpot/penpot/pull/12073))
## 2.18.1
@ -294,6 +396,7 @@
- Use hard reload for render engine switching in the workspace menu [#10441](https://github.com/penpot/penpot/issues/10441) (PR: [#10444](https://github.com/penpot/penpot/pull/10444))
- Rotate size badge when shape is rotated [#10386](https://github.com/penpot/penpot/issues/10386) (PR: [#10393](https://github.com/penpot/penpot/pull/10393))
- Add separate internal URI for exporter to handle Docker deployments where internal and public URIs differ [#10627](https://github.com/penpot/penpot/issues/10627) (PR: [#10630](https://github.com/penpot/penpot/pull/10630))
- Make throwValidationErrors default to true for v2 manifest plugins [#10401](https://github.com/penpot/penpot/issues/10401) (PR: [#10433](https://github.com/penpot/penpot/pull/10433))
### :bug: Bugs fixed
@ -401,6 +504,14 @@
- Fix text shape position-data to include required fills in WASM and DOM calculation paths [#10646](https://github.com/penpot/penpot/issues/10646) (PR: [#10650](https://github.com/penpot/penpot/pull/10650))
- Log expired OIDC tokens as auth failures instead of server errors [#10635](https://github.com/penpot/penpot/issues/10635) (PR: [#10636](https://github.com/penpot/penpot/pull/10636))
- Return 400 instead of 500 when ImageMagick rejects invalid uploaded images [#10642](https://github.com/penpot/penpot/issues/10642) (PR: [#10643](https://github.com/penpot/penpot/pull/10643))
- Fix Plugin API board.guides setting and clearing throwing malli invalid-schema error (by @filipsajdak) [#9773](https://github.com/penpot/penpot/issues/9773) (PR: [#10503](https://github.com/penpot/penpot/pull/10503))
- Fix Plugin API rejecting open-overlay and toggle-overlay interactions when position is not set (by @mvanhorn) [#10201](https://github.com/penpot/penpot/issues/10201) (PR: [#10503](https://github.com/penpot/penpot/pull/10503))
- Fix Plugin API close-overlay interaction requiring animation field (by @mvanhorn) [#10202](https://github.com/penpot/penpot/issues/10202) (PR: [#10503](https://github.com/penpot/penpot/pull/10503))
- Fix boards hidden from View Mode reappearing when adding prototype interactions (by @jeffrey701) [#10289](https://github.com/penpot/penpot/issues/10289) (PR: [#9695](https://github.com/penpot/penpot/pull/9695))
- Fix Plugin API PenpotUtils.createVariantContainer assigning variant properties to wrong components [#10506](https://github.com/penpot/penpot/issues/10506) (PR: [#10562](https://github.com/penpot/penpot/pull/10562))
- Fix mask inside flex layout shifting position or size when child image visibility changes [#10537](https://github.com/penpot/penpot/issues/10537) (PR: [#10697](https://github.com/penpot/penpot/pull/10697))
- Fix path ends selector missing arrow icons and incorrect divider colors [#10593](https://github.com/penpot/penpot/issues/10593) (PR: [#10631](https://github.com/penpot/penpot/pull/10631))
- Fix webhook form prefilling hardcoded metadata URI default [#10722](https://github.com/penpot/penpot/issues/10722) (PR: [#10723](https://github.com/penpot/penpot/pull/10723))
## 2.16.2

12
backend/deps.edn
View File

@ -6,7 +6,7 @@
org.clojure/clojure {:mvn/version "1.12.6"}
org.clojure/tools.namespace {:mvn/version "1.5.1"}
com.github.luben/zstd-jni {:mvn/version "1.5.7-20"}
com.github.luben/zstd-jni {:mvn/version "1.5.7-21"}
io.prometheus/simpleclient {:mvn/version "0.16.0"}
io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
@ -37,7 +37,7 @@
{:mvn/version "1.3.1118"}
metosin/reitit-core {:mvn/version "0.11.0"}
nrepl/nrepl {:mvn/version "1.7.0"}
nrepl/nrepl {:mvn/version "1.8.0"}
org.postgresql/postgresql {:mvn/version "42.7.13"}
org.xerial/sqlite-jdbc {:mvn/version "3.53.4.0"}
@ -50,7 +50,7 @@
buddy/buddy-sign {:mvn/version "3.6.1-359"}
org.passay/passay {:mvn/version "2.0.0"}
com.github.ben-manes.caffeine/caffeine {:mvn/version "3.2.4"}
com.github.ben-manes.caffeine/caffeine {:mvn/version "3.3.0"}
org.jsoup/jsoup {:mvn/version "1.23.2"}
@ -64,10 +64,10 @@
;; Pretty Print specs
pretty-spec/pretty-spec {:mvn/version "0.1.4"}
software.amazon.awssdk/s3 {:mvn/version "2.55.6"}
software.amazon.awssdk/sts {:mvn/version "2.55.6"}
software.amazon.awssdk/s3 {:mvn/version "2.55.11"}
software.amazon.awssdk/sts {:mvn/version "2.55.11"}
com.ladybugdb/lbug {:mvn/version "0.20.4"}
com.ladybugdb/lbug {:mvn/version "0.21.2"}
;; Required by Arrow RootAllocator (lbug only pulls arrow-memory-core).
org.apache.arrow/arrow-memory-netty {:mvn/version "19.0.0"}}

2
backend/package.json
View File

@ -4,7 +4,7 @@
"license": "MPL-2.0",
"author": "Kaleidos INC Sucursal en España SL",
"private": true,
"packageManager": "pnpm@12.6.0+sha512.3ef68f951cb111ac204b4a5a16f0b2ddf0da56a96e0413e81d855d9f0b55ef926714709028e1cd00c405c2c5fb7b9e8ec4dc46777c805d0373c2f2ff00fd20ec",
"packageManager": "pnpm@12.8.1+sha512.f64ba907507f5ceafe06c8d38e6052d0179444580ec1279ddd5bfc11cb48aa8a2644b66598e07e761da84872a9fc57d5f902b87fa49d024198d558612aabbe45",
"repository": {
"type": "git",
"url": "https://github.com/penpot/penpot"

122
backend/pnpm-lock.yaml generated
View File

@ -7,153 +7,153 @@ importers:
configDependencies: {}
packageManagerDependencies:
pnpm:
specifier: 12.6.0
version: 12.6.0
specifier: 12.8.1
version: 12.8.1
packages:
'@pnpm/exe.android-arm64@12.6.0':
resolution: {integrity: sha512-kviIHft9h02q+7N2In7tSL9T/HRUSGwYmU74YPtsWU5ee7vgqPyC0JT6RRX6miW+NxX1CvHgQxg69qq1qTLJYQ==}
'@pnpm/exe.android-arm64@12.8.1':
resolution: {integrity: sha512-siDxcidfz5eM6L2tJfik+i2bbUEw8UC7MZ3Yl2HYdRmqbdhHGAOQACtOOu6QVW4Jul4/w5wVKm+wM8ACtgh1Pg==}
cpu: [arm64]
os: [android]
'@pnpm/exe.android-x64@12.6.0':
resolution: {integrity: sha512-CT8aJKLq2mtZFE71pr4E5Z2xHL8uGnRGr+NclDqsXlVF4SVcQ2QAs14mWi0C8gjT4hbmi+Q0lJRRIkMAWfjjng==}
'@pnpm/exe.android-x64@12.8.1':
resolution: {integrity: sha512-0F/uqPRc3aN4vLHsa0f+6fTtmsigFQ9/yxEU43fionF//pNHEd5e97b3w/nKIgqYMCUQCJphmBRMA9Q8/wlo9Q==}
cpu: [x64]
os: [android]
'@pnpm/exe.darwin-arm64@12.6.0':
resolution: {integrity: sha512-rafpVkjzugKBMxSvGQd5wK1x5eOTkD/+lcJIFHeQhvd+BJ8kDisOOvwhQDrpGd4vd2Fx+hhW0P2Ptt638OlhFg==}
'@pnpm/exe.darwin-arm64@12.8.1':
resolution: {integrity: sha512-/rwavvMQJsl2RIxOHBnDF+4Gk+fhQFAY4M3PQZoKskJOEnaJcygG9p1xby6wcQcbS4d9dIubv09CQhufTgfmpw==}
cpu: [arm64]
os: [darwin]
'@pnpm/exe.darwin-x64@12.6.0':
resolution: {integrity: sha512-72Jpuv1m24gI8zUNcaylYpBWEhBzz1VPhnDIU2GYM2eRP+KsOqVLwV78i+JrihI39zY2NNXmaN4eAKX1inpaDQ==}
'@pnpm/exe.darwin-x64@12.8.1':
resolution: {integrity: sha512-htYt2gN7zqJKLhC99Ft6EUiO7myjZAZXfmGCTJUL1v+o7vE9hZdE1+fAkk4Oj1ZHNRti6b2woOxEkRkAusi8OQ==}
cpu: [x64]
os: [darwin]
'@pnpm/exe.freebsd-x64@12.6.0':
resolution: {integrity: sha512-LON4QgNy1w/XF4uySZIyC/5hEB0oGdelXsY9tSKqstER+2j2X2oHz67skD11RRd/HWFRtMr64shQZ4I9ZoZ0zg==}
'@pnpm/exe.freebsd-x64@12.8.1':
resolution: {integrity: sha512-PB5BULNgytxvExoOXUUeseS/DcpPENs+cg3iA6xHHeaLT4ctEGKSGXEbuj7USeqvo8JBpAx039hivnbzGqDwnA==}
cpu: [x64]
os: [freebsd]
'@pnpm/exe.linux-arm64-musl@12.6.0':
resolution: {integrity: sha512-BdDpX+DeaMUc5x6WNcE6FkmFy36NwrBbBvwsZU737Zt3u1fTY+iKFPchjEQNCM4rT6q6xvF2oN3ZwExGsJCkxQ==}
'@pnpm/exe.linux-arm64-musl@12.8.1':
resolution: {integrity: sha512-kKeyC/ArjrgdciQRBrOL0j9HtOI4gDRgoyP+eJ1CQKyadpKlf/DhDDyspXe07R3B9KagTVLUF2nlt6Dr5quFIg==}
cpu: [arm64]
os: [linux]
libc: [musl]
'@pnpm/exe.linux-arm64@12.6.0':
resolution: {integrity: sha512-8h2sNoIhHDpHDYqZZCh9PXr6krqW10btb0GHVGuw710muDHlFAHMtUG2ogmaHge6zJG1xgY4Y7mwX5g/LWvrYg==}
'@pnpm/exe.linux-arm64@12.8.1':
resolution: {integrity: sha512-q4s9a9X2O3N9aeUFooW24orNrxvu20+jyVUFR5RanPCqOKKPBrgs2iywMkBBx1aXkkzdWT54/mfz8Be8sJlWEw==}
cpu: [arm64]
os: [linux]
libc: [glibc]
'@pnpm/exe.linux-ppc64@12.6.0':
resolution: {integrity: sha512-ld6xgcEhFCFrsVsJhbmdmR714PnsEspO/Ij8w0/D7OSiz2hYGu3fZd5tKRxOI5m6H6Gl0/RRFAPncTHbsgXVjQ==}
'@pnpm/exe.linux-ppc64@12.8.1':
resolution: {integrity: sha512-F7XSjKJthwCh/L6abZiMpAfo2Cm61SZIT3e4dfgiIjESndlWaXCnfLKngSgZ/SEMsdmHT6dud3+kWIB3tw0/xQ==}
cpu: [ppc64]
os: [linux]
libc: [glibc]
'@pnpm/exe.linux-riscv64@12.6.0':
resolution: {integrity: sha512-HIbImydoC3J8NFt+8MXfhTCf5rO6NjCMyinSAHac0VmV8uCHw+kbQkyAzxV84rzz9ZOzmBOnj0b1N461UIYGsw==}
'@pnpm/exe.linux-riscv64@12.8.1':
resolution: {integrity: sha512-z1ecpIK/ZY08Unk69KWWE9867oaKUytGUjrHnBoGFAAhsK+q+0cfvBH+f5fWobJ7FX97leMlLO+gkJolddM45Q==}
cpu: [riscv64]
os: [linux]
libc: [glibc]
'@pnpm/exe.linux-s390x@12.6.0':
resolution: {integrity: sha512-DjSqT7+BZ/lWcDHwNMuzsRVfyxUimh+D54Xw4tSWbdVVQhtWtNMUyI93LVnwCmsoEpar2gC3SFeAgywx37svKQ==}
'@pnpm/exe.linux-s390x@12.8.1':
resolution: {integrity: sha512-KU6tnrBfu4uKXTq6N5qJwSm8FSrs9Wc8b5AUEsHK9bRXwNdsZ1/lRxG1++X29SKRW9OSNuDSjxASv5mAvGo1gA==}
cpu: [s390x]
os: [linux]
libc: [glibc]
'@pnpm/exe.linux-x64-musl@12.6.0':
resolution: {integrity: sha512-31lKeGPmRE6xfV6I3VjaEGVFRei14pl/zgoFDK4w+UkbJqOuNl2Ht3O1GuqNIg3Gl14qTEb4kZRAYFHXifDx9A==}
'@pnpm/exe.linux-x64-musl@12.8.1':
resolution: {integrity: sha512-eUE8BWJkDr2tJb/yrk0yVnszlmNqFarVxUlqiZ9BAkct28Nq/5g2H0tvMDmPA7fAQW3STNj+omJPPRVT+4s5sQ==}
cpu: [x64]
os: [linux]
libc: [musl]
'@pnpm/exe.linux-x64@12.6.0':
resolution: {integrity: sha512-qFWBneHJAJ73W4whtbaFOL1M/7DBC6ILHXuxc7ZPtEhfPuT1zeZiGrmKHoMAfJA+mcm6xhOFljqVTUS+00Jabw==}
'@pnpm/exe.linux-x64@12.8.1':
resolution: {integrity: sha512-8bDZ0lZlCdi2rvnFul7EYgcC7zKeWSe76y8JV2oXobaS8p9i9d6PSf6LgLtTM0fI7R9Oh4eLCbveXyNDMmvZ+g==}
cpu: [x64]
os: [linux]
libc: [glibc]
'@pnpm/exe.win32-arm64@12.6.0':
resolution: {integrity: sha512-OhfefXEEykZlslSUhR8PPRe6MVPV3Oink/dVfIecE5velpc7j80cZYsHlaDrtRDcm3TPwQHkaRW1SJ1efX9oFg==}
'@pnpm/exe.win32-arm64@12.8.1':
resolution: {integrity: sha512-MsT0dlrRxnCRCHCaosNbhWpEiAFnFuMEu3KuDJDU41BXgTwiINxU8goloUSUDejWZUqKaUqNC/qUTihl9nFtqg==}
cpu: [arm64]
os: [win32]
'@pnpm/exe.win32-x64@12.6.0':
resolution: {integrity: sha512-L2tuyrD2+Imgxs3VK/ST/2L3xD6vDP0ktJQxM0TaGw7TbAQEMq+RMc8iK6Ew7Id579uzjJe8jSfJID2ZGsOHCA==}
'@pnpm/exe.win32-x64@12.8.1':
resolution: {integrity: sha512-SWtPe0PsbTTk//gJND10tMdOfCYjrkq5+qV49hzVhY7xz2iJ339Rc+xwASlcvbwTfrvH39YNqpKYibD+CRGLwA==}
cpu: [x64]
os: [win32]
pnpm@12.6.0:
resolution: {integrity: sha512-PvaPlRyxEawgS0paFvCy3fDaVqluBBPoHYVdnwtV75JnFHCQKOHNAMQFwsX7e56OxNxGd3yAXQNzwvL/AP0g7A==}
pnpm@12.8.1:
resolution: {integrity: sha512-9kupB1B/XOr+BsjTjmBS0BeURFgOwSed3Vv8EctIqoomRLZlmOB+dh2oSHKp/FfV+QK4f6SdAkGY1VhhKqu+RQ==}
engines: {node: '>=18.*'}
hasBin: true
snapshots:
'@pnpm/exe.android-arm64@12.6.0':
'@pnpm/exe.android-arm64@12.8.1':
optional: true
'@pnpm/exe.android-x64@12.6.0':
'@pnpm/exe.android-x64@12.8.1':
optional: true
'@pnpm/exe.darwin-arm64@12.6.0':
'@pnpm/exe.darwin-arm64@12.8.1':
optional: true
'@pnpm/exe.darwin-x64@12.6.0':
'@pnpm/exe.darwin-x64@12.8.1':
optional: true
'@pnpm/exe.freebsd-x64@12.6.0':
'@pnpm/exe.freebsd-x64@12.8.1':
optional: true
'@pnpm/exe.linux-arm64-musl@12.6.0':
'@pnpm/exe.linux-arm64-musl@12.8.1':
optional: true
'@pnpm/exe.linux-arm64@12.6.0':
'@pnpm/exe.linux-arm64@12.8.1':
optional: true
'@pnpm/exe.linux-ppc64@12.6.0':
'@pnpm/exe.linux-ppc64@12.8.1':
optional: true
'@pnpm/exe.linux-riscv64@12.6.0':
'@pnpm/exe.linux-riscv64@12.8.1':
optional: true
'@pnpm/exe.linux-s390x@12.6.0':
'@pnpm/exe.linux-s390x@12.8.1':
optional: true
'@pnpm/exe.linux-x64-musl@12.6.0':
'@pnpm/exe.linux-x64-musl@12.8.1':
optional: true
'@pnpm/exe.linux-x64@12.6.0':
'@pnpm/exe.linux-x64@12.8.1':
optional: true
'@pnpm/exe.win32-arm64@12.6.0':
'@pnpm/exe.win32-arm64@12.8.1':
optional: true
'@pnpm/exe.win32-x64@12.6.0':
'@pnpm/exe.win32-x64@12.8.1':
optional: true
pnpm@12.6.0:
pnpm@12.8.1:
optionalDependencies:
'@pnpm/exe.android-arm64': 12.6.0
'@pnpm/exe.android-x64': 12.6.0
'@pnpm/exe.darwin-arm64': 12.6.0
'@pnpm/exe.darwin-x64': 12.6.0
'@pnpm/exe.freebsd-x64': 12.6.0
'@pnpm/exe.linux-arm64': 12.6.0
'@pnpm/exe.linux-arm64-musl': 12.6.0
'@pnpm/exe.linux-ppc64': 12.6.0
'@pnpm/exe.linux-riscv64': 12.6.0
'@pnpm/exe.linux-s390x': 12.6.0
'@pnpm/exe.linux-x64': 12.6.0
'@pnpm/exe.linux-x64-musl': 12.6.0
'@pnpm/exe.win32-arm64': 12.6.0
'@pnpm/exe.win32-x64': 12.6.0
'@pnpm/exe.android-arm64': 12.8.1
'@pnpm/exe.android-x64': 12.8.1
'@pnpm/exe.darwin-arm64': 12.8.1
'@pnpm/exe.darwin-x64': 12.8.1
'@pnpm/exe.freebsd-x64': 12.8.1
'@pnpm/exe.linux-arm64': 12.8.1
'@pnpm/exe.linux-arm64-musl': 12.8.1
'@pnpm/exe.linux-ppc64': 12.8.1
'@pnpm/exe.linux-riscv64': 12.8.1
'@pnpm/exe.linux-s390x': 12.8.1
'@pnpm/exe.linux-x64': 12.8.1
'@pnpm/exe.linux-x64-musl': 12.8.1
'@pnpm/exe.win32-arm64': 12.8.1
'@pnpm/exe.win32-x64': 12.8.1
---
lockfileVersion: '9.0'

61
backend/resources/climit.edn
View File

@ -1,63 +1,80 @@
;; Example climit.edn file
;; Required: permits
;; Optional: queue, ommited means Integer/MAX_VALUE
;; Optional: timeout, ommited means no timeout
;; Note: queue and timeout are excluding
{:update-file/global {:permits 20}
;; Optional: queue, omitted means Integer/MAX_VALUE (unbounded)
;; Optional: timeout in milliseconds, omitted means the thread waits for a
;; permit forever, and a saturated limiter parks it for good. Values below:
;; 60s for operations that can be slow (file updates, images, fonts, thumbnails,
;; snapshots, imports) and 30s for the rest.
;; Note: a queue bounds how many waiters pile up, a timeout bounds how long one
;; waiter waits. Every entry sets a timeout; the by-profile ones also set a
;; queue, which is where a pile-up hurts.
{:update-file/global
{:permits 20 :timeout 60000}
:update-file/by-profile
{:permits 1 :queue 5}
{:permits 1 :queue 5 :timeout 60000}
:process-font/global {:permits 4}
:process-font/by-profile {:permits 1}
:process-font/global
{:permits 4 :timeout 60000}
:process-font/by-profile
{:permits 1 :timeout 60000}
:process-image/global {:permits 8}
:process-image/by-profile {:permits 1}
:process-image/global
{:permits 8 :timeout 60000}
:process-image/by-profile
{:permits 1 :timeout 60000}
:auth/global {:permits 8}
:auth/global
{:permits 8 :timeout 30000}
:root/global
{:permits 40}
{:permits 40 :timeout 30000}
:root/by-profile
{:permits 10 :queue 30 :timeout 30000}
:file-thumbnail-ops/global
{:permits 20}
{:permits 20 :timeout 60000}
:file-thumbnail-ops/by-profile
{:permits 2}
{:permits 2 :timeout 60000}
:submit-audit-events/by-profile
{:permits 1 :queue 3}
{:permits 1 :queue 3 :timeout 30000}
:restore-file-snapshot/global
{:permits 3}
{:permits 3 :timeout 60000}
:restore-file-snapshot/by-profile
{:permits 1 :queue 2 :timeout 60000}
:create-file-snapshot/global
{:permits 3}
{:permits 3 :timeout 60000}
:create-file-snapshot/by-profile
{:permits 1 :queue 2 :timeout 60000}
:send-user-feedback/global
{:permits 4}
{:permits 4 :timeout 30000}
:send-user-feedback/by-profile
{:permits 1 :queue 3}
{:permits 1 :queue 3 :timeout 30000}
:import-binfile/global
{:permits 4}
{:permits 4 :timeout 60000}
:import-binfile/by-profile
{:permits 1 :queue 2}
{:permits 1 :queue 2 :timeout 60000}
:create-import-binfile-job/global
{:permits 4 :timeout 60000}
:create-import-binfile-job/by-profile
{:permits 1 :queue 2 :timeout 60000}
:profile-plugin-ops/global
{:permits 4}
{:permits 4 :timeout 30000}
:profile-plugin-ops/by-profile
{:permits 1 :queue 2}
{:permits 1 :queue 2 :timeout 30000}
;; Every limit below is provisional. The container that runs the preview
;; has no heap cap: `docker/devenv/files/entrypoint.sh` and

139
backend/src/app/binfile/common.clj
View File

@ -16,6 +16,7 @@
[app.common.files.migrations :as fmg]
[app.common.files.validate :as fval]
[app.common.logging :as l]
[app.common.media :as cm]
[app.common.schema :as sm]
[app.common.time :as ct]
[app.common.types.file :as ctf]
@ -28,6 +29,8 @@
[app.features.file-migrations :as fmigr]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.media.svg :as svg]
[app.storage :as sto]
[app.util.blob :as blob]
[app.util.pointer-map :as pmap]
[app.worker :as-alias wrk]
@ -69,11 +72,15 @@
(* 1024 1024 20))
;; Maximum total decompressed size allowed for all JSON/text zip entries
;; combined within a single import job: 200MiB. Bounds the case where many
;; combined within a single import job: 500MiB. Bounds the case where many
;; entries, each individually under default-max-text-entry-size, still sum
;; to an unreasonable total.
;; to an unreasonable total. Set this high because legitimate giant
;; exports exist: hundreds of thousands of KB-sized entries (pages,
;; shapes) that never trip the per-entry cap but sum past 400MiB. The
;; per-entry cap still bounds single-entry DEFLATE amplification, so this
;; only moves the cumulative ceiling.
(def ^:const default-max-text-total-size
(* 1024 1024 200))
(* 1024 1024 500))
;; Maximum number of entries allowed in the import zip: 500,000.
(def ^:const default-max-zip-entries
@ -625,8 +632,13 @@
fpr.can_edit
from file_profile_rel as fpr
inner join file as f on (f.id = fpr.file_id)
inner join project as p on (p.id = f.project_id)
where fpr.file_id = ?
and fpr.profile_id = ?
and exists (select 1
from team_profile_rel as tpr
where tpr.team_id = p.team_id
and tpr.profile_id = fpr.profile_id)
union all
select tpr.is_owner,
tpr.is_admin,
@ -642,8 +654,13 @@
ppr.can_edit
from project_profile_rel as ppr
inner join file as f on (f.project_id = ppr.project_id)
inner join project as p on (p.id = ppr.project_id)
where f.id = ?
and ppr.profile_id = ?")
and ppr.profile_id = ?
and exists (select 1
from team_profile_rel as tpr
where tpr.team_id = p.team_id
and tpr.profile_id = ppr.profile_id)")
(defn- get-file-permissions*
[conn profile-id file-id]
@ -1208,6 +1225,7 @@
load-fn #(get-file cfg % :migrate? false)]
(weak/loadable-weak-value-map library-ids load-fn {id file})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EXTERNAL LIBRARY RESOLUTION HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1251,3 +1269,116 @@
[cfg team-id slug]
(->> (get-shared-files-for-team cfg team-id)
(filter #(= slug (slugify-name (:name %))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SVG IMPORT SANITIZATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def svg-content-type
"Canonical content type of SVG media objects."
"image/svg+xml")
(defn normalize-content-type
"Canonicalize a stored content-type: lowercase, trimmed,
parameters after `;` dropped. Returns nil for missing or unusable
values so ancient bundle entries without content-type keep passing
through untouched."
[ctype]
(when (string? ctype)
(let [clean (-> ctype
(str/split #";" 2)
(first)
(str/trim)
(str/lower))]
(when-not (str/empty? clean)
clean))))
(defn svg-object?
"True when the storage `object` claims the canonical SVG content
type. Expects an already normalized object (see
`normalize-content-type`): every import path normalizes the
metadata right after reading it, so the comparison stays an exact
match in a single place."
[object]
(= svg-content-type (:content-type object)))
(def schema:content-type
"Typed content-type for binfile storage objects: a member of
`cm/storage-object-types`. Values are canonicalized with
`normalize-content-type` before validation, so legacy spellings
keep importing while unknown types are rejected."
[::sm/one-of {:format :string} cm/storage-object-types])
(defn check-storage-content-type
"Check an imported storage `object` (already normalized, see
`normalize-content-type`) against `cm/storage-object-types`.
Returns nil when the type is allowed; raises `:type :validation`
with `:code :media-type-not-allowed` (same as the upload path)
when it is missing or unknown, so crafted bundles fail closed."
[object]
(when-not (contains? cm/storage-object-types (:content-type object))
(ex/raise :type :validation
:code :media-type-not-allowed
:hint "storage object declares an unknown content-type"
:content-type (:content-type object))))
(defn sanitize-imported-svg
"Sanitize the raw `bytes` of an imported storage `object` when it
holds an SVG document. Expects an already normalized object (see
`normalize-content-type`); returns nil when the object is not an
SVG.
Otherwise returns a map with the sanitized `:bytes`, their `:size`
and their blake2b `:hash`, ready to persist with `sto/put-object!`.
Raises a `:validation` exception when the SVG cannot be parsed, the
same error the upload path reports."
[object ^bytes raw]
(when (svg-object? object)
(let [sanitized (svg/sanitize-svg (String. ^bytes raw "UTF-8"))
bytes (.getBytes ^String sanitized "UTF-8")]
{:bytes bytes
:size (alength ^bytes bytes)
:hash (sto/calculate-hash (java.io.ByteArrayInputStream. bytes))})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REQUEST CFG
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn resolve-export-type
"The canonical export type of a request on the legacy RPC: an explicit
`type` wins, and the deprecated boolean flags are translated. The
creation command of a job does not need it, because it asks the caller
for the type instead of guessing it."
[{:keys [type include-libraries embed-assets]}]
(cond
(some? type) type
(true? include-libraries) :include-libraries
(true? embed-assets) :merge-libraries
:else :detach-libraries))
(defn export-cfg
"The domain cfg of an export: the frozen set of files and how their
libraries are handled."
[cfg {:keys [ids export-type]}]
(-> cfg
(assoc ::ids ids)
(assoc ::export-type export-type)))
(defn import-cfg
"The domain cfg of an import: the destination team/profile/project, the
name, the input and the anti-zip-bomb limits. The caller resolves the
team, because what allows it to import there differs between the RPC and
a job; what both must share is fixed here."
[cfg {:keys [profile-id project-id team name input]}]
(-> cfg
(assoc ::features (cfeat/get-team-enabled-features cf/flags team))
(assoc ::project-id project-id)
(assoc ::profile-id profile-id)
(assoc ::team-id (:id team))
(assoc ::name name)
(assoc ::input input)
(assoc ::import-max-binary-entry-size (cf/get :binfile-import-max-binary-entry-size))
(assoc ::import-max-text-entry-size (cf/get :binfile-import-max-text-entry-size))
(assoc ::import-max-text-total-size (cf/get :binfile-import-max-text-total-size))
(assoc ::import-max-zip-entries (cf/get :binfile-import-max-zip-entries))))

171
backend/src/app/binfile/jobs.clj Normal file
View File

@ -0,0 +1,171 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.binfile.jobs
"The binfile work a job runs.
A job has no SSE channel, so the `:progress` points that `bf.v1` and
`bf.v3` emit become `progress` events of the job through
`jobs/heartbeat`, which throttles them and drops the ones that do not
fit. The adapter turns a tap into a self-contained milestone: a `:stage`
of a single vocabulary (the two formats name the same work differently)
and the counters the tap carries, with the outer scopes in course as
context. The reader puts the outer counters in every tap inside them,
so the adapter holds no state between taps. The ids the taps carry are
not part of the job event contract.
The adapter checks that the job is still active before it starts, and
the beat checks it on every write: a job that was cancelled, or that
already reached a terminal state, raises an `:interrupt` right there on
the run thread, so the work stops at its next event point and the
transaction of its handler rolls back with it. A run whose last tap
happened before the interruption is discarded once it returns, which is
what makes that transaction roll back too."
(:require
[app.binfile.common :as bfc]
[app.binfile.v1 :as bf.v1]
[app.binfile.v3 :as bf.v3]
[app.common.exceptions :as ex]
[app.common.time :as ct]
[app.db :as db]
[app.jobs :as jobs]
[app.util.events :as events]))
(defn check-active
"Raise an `:interrupt` when the job is no longer active.
The substrate owns both the check and the error; this is the adapter's
entry point to it, used by the two handlers before their run and by the
tests."
[cfg context]
(jobs/check-active cfg (:id context)))
(def ^:private stage-of
"The stage a tap section becomes: one vocabulary for the two formats, so
a client resolves each stage once. The counter of the activity is named
after its own stage, which is what lets a client render
`counters[stage]` without a table of equivalences."
{:file :files
:page :pages
:media :media
:thumbnail :thumbnails
:thumbnails :thumbnails
:component :components
:color :colors
:typography :typographies
:tokens-lib :tokens
:tokens-status :tokens
:storage-object :storage-objects
:storage-objects :storage-objects
:relations :relations
:manifest :manifest
:v1/metadata :metadata
:v1/files :files
:v1/rels :relations
:v1/sobjects :storage-objects})
(defn- stage
"The stage of a tap section; a section without a name of its own keeps
it, so a new tap is never dropped from the stream."
[section]
(get stage-of section section))
(defn- counter
"The counter a tap reports, when it reports one: a tap that only marks a
point of the run has no units to count."
[{:keys [current total]}]
(when (some? current)
(cond-> {:current current}
(some? total)
(assoc :total total))))
(defn- milestone
"The milestone a tap becomes: what the job is doing now and the counters
the tap carries, with the outer scopes in course as context.
The tap of a scope carries its outer counters, so the milestone is
self-contained and the adapter remembers nothing between taps: a client
that misses one (the substrate throttles the events) still renders the
truth from the next."
[{:keys [section outer-counters] :as tap}]
(let [stage (stage section)
own (counter tap)]
(cond-> {:stage stage}
(or (some? outer-counters) (some? own))
(assoc :counters (cond-> (or outer-counters {})
(some? own) (assoc stage own))))))
(defn- with-progress
"Run `f` with the progress taps of the core turned into milestones of the
job.
Every tap is reported: the substrate throttles the durable events, and
a milestone that does not fit loses no information because the next one
carries the same state.
The taps run on this same thread: the sink calls the heartbeat inline,
so an `:interrupt` it raises aborts the core right there, inside the
transaction of its handler, which rolls back."
[cfg context f]
(let [job-id (:id context)
sink (fn [[type data]]
(when (= :progress type)
(jobs/heartbeat cfg
:job-id job-id
:progress (milestone data))))]
(binding [events/*sink* sink]
(let [result (f)]
(check-active cfg context)
result))))
(defn export-files
"Export a set of files into `output` as part of a job, reporting
progress as job events."
[cfg context {:keys [ids export-type output]}]
(check-active cfg context)
(with-progress cfg context
#(bf.v3/export-files! (bfc/export-cfg cfg {:ids ids
:export-type export-type})
output)))
(defn- touch-project
"Mark the destination project as modified.
An import adds files, and the triggers of the schema only touch the
project on an update, so a project that just received files keeps its
old date and stays where it was in the list."
[cfg project-id]
(db/update! cfg :project
{:modified-at (ct/now)}
{:id project-id}
{::db/return-keys false}))
(defn import-files
"Import the package at `input` as part of a job, reporting progress as
job events. The package was read from the resource of the job, so the
caller resolves the destination team and the adapter only fixes what
the legacy RPC and a job must share.
Both formats answer with the same shape: the version 1 reader returns
the set of files it created, and the version 3 one returns a map that
already carries them together with the resolution of the libraries."
[cfg context {:keys [profile-id project-id team name input version]}]
(check-active cfg context)
(let [cfg (bfc/import-cfg cfg {:profile-id profile-id
:project-id project-id
:team team
:name name
:input input})]
(with-progress cfg context
#(let [result (case (int version)
1 {:file-ids (vec (bf.v1/import-files! cfg))}
3 (bf.v3/import-files! cfg)
(ex/raise :type :validation
:code :unsupported-version
:hint "unsupported binfile version"
:version version))]
(touch-project cfg project-id)
result))))

12
backend/src/app/binfile/v1.clj
View File

@ -607,16 +607,26 @@
(doseq [expected-storage-id ids]
(let [id (read-uuid! input)
mdata (read-obj! input)]
mdata (d/update-when (read-obj! input) :content-type bfc/normalize-content-type)]
(when (not= id expected-storage-id)
(ex/raise :type :validation
:code :inconsistent-penpot-file
:hint "the penpot file seems corrupt, found unexpected uuid (storage-object-id)"))
(bfc/check-storage-content-type mdata)
(l/dbg :hint "readed storage object" :id (str id) ::l/sync? true)
(let [[size resource] (read-stream! input)
[resource size] (if (bfc/svg-object? mdata)
(let [raw (if (bytes? resource)
resource
(with-open [istream (jio/input-stream resource)]
(io/read istream)))
{:keys [bytes size]} (bfc/sanitize-imported-svg mdata raw)]
[bytes size])
[resource size])
hash (sto/calculate-hash resource)
content (-> (sto/content resource size)
(sto/wrap-with-hash hash))

12
backend/src/app/binfile/v2.clj
View File

@ -197,9 +197,17 @@
(defn- read-storage-object!
[{:keys [::sto/storage ::bfc/timestamp] :as cfg} id]
(let [mdata (read-obj cfg :storage-object id)
(let [mdata (d/update-when (read-obj cfg :storage-object id)
:content-type bfc/normalize-content-type)
data (read-blob cfg :storage-object id)
hash (sto/calculate-hash data)
;; NOTE: v2 bundles are legacy and no longer produced; the
;; sanitizer call stays as defense in depth and is covered by
;; the shared helper unit tests, with no dedicated v2
;; import test.
clean (when (bfc/svg-object? mdata)
(bfc/sanitize-imported-svg mdata data))
data (or (:bytes clean) data)
hash (or (:hash clean) (sto/calculate-hash data))
content (-> (sto/content data)
(sto/wrap-with-hash hash))

262
backend/src/app/binfile/v3.clj
View File

@ -86,7 +86,7 @@
[:map {:title "StorageObject"}
[:id ::sm/uuid]
[:size ::sm/int]
[:content-type :string]
[:content-type bfc/schema:content-type]
[:bucket [::sm/one-of {:format :string} sto/valid-buckets]]
[:hash {:optional true} :string]])
@ -231,6 +231,32 @@
(def validate-file-thumbnail
(sm/check-fn schema:file-thumbnail))
;; --- PROGRESS
(defn- tap-progress
"Emit a progress tap of the core, with the counters of the outer scopes
in course when the cfg has any.
The outer counters live in `::outer-counters` of the cfg while a scope
is being processed (today only `:files`, tomorrow `:teams` and
`:projects` too), so every tap inside carries them as `:outer-counters`:
the stages inside do not repeat them, and whoever reads the taps (the
jobs adapter) builds its report from one tap alone instead of
remembering the last position it saw. A tap that happens outside any
scope carries no outer counters, which is the truth about it."
[cfg data]
(events/tap :progress
(cond-> data
(some? (::outer-counters cfg))
(assoc :outer-counters (::outer-counters cfg)))))
(defn- with-outer-counter
"Return cfg with the counter of `scope` set to `position`, keeping the
counters of the other outer scopes already in course, so entering a
nested scope never wipes the ones above it."
[cfg scope position]
(assoc-in cfg [::outer-counters scope] position))
;; --- EXPORT IMPL
(defn- write-entry!
@ -264,8 +290,10 @@
(defn- export-storage-objects
[{:keys [::output] :as cfg}]
(let [storage (sto/resolve cfg)]
(doseq [id (-> bfc/*state* deref :storage-objects not-empty)]
(let [storage (sto/resolve cfg)
ids (-> bfc/*state* deref :storage-objects not-empty)
total (count ids)]
(doseq [[index id] (d/enumerate ids)]
(let [sobject (sto/get-object storage id)
smeta (meta sobject)
ext (cmedia/mtype->extension (:content-type smeta))
@ -277,7 +305,8 @@
(write-entry! output path params)
(events/tap :progress {:section :storage-object :id id})
(tap-progress cfg {:section :storage-object :id id
:current (inc index) :total total})
(with-open [input (sto/get-object-data storage sobject)]
(.putNextEntry ^ZipOutputStream output (ZipEntry. (str "objects/" id ext)))
@ -305,7 +334,7 @@
thumbnails (bfc/get-file-object-thumbnails cfg file-id)]
(events/tap :progress {:section :file :id file-id :name (:name file)})
(tap-progress cfg {:section :file :id file-id :name (:name file)})
(vswap! bfc/*state* update :files assoc file-id
{:id file-id
@ -339,7 +368,8 @@
(write-entry! output path page)
(events/tap :progress {:section :page :id page-id :name (:name page) :file-id file-id})
(tap-progress cfg {:section :page :id page-id :name (:name page) :file-id file-id
:current (inc index) :total (count pages)})
(doseq [[shape-id shape] objects]
(let [path (str "files/" file-id "/pages/" page-id "/" shape-id ".json")
@ -350,30 +380,33 @@
(vswap! bfc/*state* bfc/collect-storage-objects media)
(vswap! bfc/*state* bfc/collect-storage-objects thumbnails)
(doseq [{:keys [id] :as media} media]
(let [path (str "files/" file-id "/media/" id ".json")
media (encode-media media)]
(doseq [[index {:keys [id] :as item}] (d/enumerate media)]
(let [path (str "files/" file-id "/media/" id ".json")
encoded (encode-media item)]
(events/tap :progress {:section :media :id id :file-id file-id})
(write-entry! output path media)))
(tap-progress cfg {:section :media :id id :file-id file-id
:current (inc index) :total (count media)})
(write-entry! output path encoded)))
(doseq [thumbnail thumbnails]
(doseq [[index thumbnail] (d/enumerate thumbnails)]
(let [data (cth/parse-object-id (:object-id thumbnail))
path (str "files/" file-id "/thumbnails/" (:tag data) "/" (:page-id data)
"/" (:frame-id data) ".json")
data (-> data
(assoc :media-id (:media-id thumbnail))
(encode-file-thumbnail))]
(events/tap :progress {:section :thumbnails :id (:object-id thumbnail) :file-id file-id})
(tap-progress cfg {:section :thumbnails :id (:object-id thumbnail) :file-id file-id
:current (inc index) :total (count thumbnails)})
(write-entry! output path data)))
(doseq [[id component] components]
(doseq [[index [id component]] (d/enumerate components)]
(let [path (str "files/" file-id "/components/" id ".json")
component (encode-component component)]
(events/tap :progress {:section :component :id id :file-id file-id})
(tap-progress cfg {:section :component :id id :file-id file-id
:current (inc index) :total (count components)})
(write-entry! output path component)))
(doseq [[id color] colors]
(doseq [[index [id color]] (d/enumerate colors)]
(let [path (str "files/" file-id "/colors/" id ".json")
color (-> (encode-color color)
(dissoc :file-id))
@ -381,20 +414,22 @@
(and (contains? color :path)
(str/empty? (:path color)))
(dissoc :path))]
(events/tap :progress {:section :color :id id :file-id file-id})
(tap-progress cfg {:section :color :id id :file-id file-id
:current (inc index) :total (count colors)})
(write-entry! output path color)))
(doseq [[id object] typographies]
(doseq [[index [id object]] (d/enumerate typographies)]
(let [path (str "files/" file-id "/typographies/" id ".json")
typography (encode-typography object)]
(events/tap :progress {:section :typography :id id :file-id file-id})
(tap-progress cfg {:section :typography :id id :file-id file-id
:current (inc index) :total (count typographies)})
(write-entry! output path typography)))
(when (and tokens-lib
(not (ctob/empty-lib? tokens-lib)))
(let [path (str "files/" file-id "/tokens.json")
encoded-tokens (encode-tokens-lib tokens-lib)]
(events/tap :progress {:section :tokens-lib :file-id file-id})
(tap-progress cfg {:section :tokens-lib :file-id file-id})
(write-entry! output path encoded-tokens)))
(when tokens-status
@ -410,7 +445,7 @@
encoded-status (-> (encode-tokens-status tokens-status)
(cfo/ids->names effective-tokens-lib))]
(events/tap :progress {:section :tokens-status :file-id file-id})
(tap-progress cfg {:section :tokens-status :file-id file-id})
(write-entry! output path encoded-status)))))
(defn- export-files
@ -449,7 +484,8 @@
(doseq [[index file-id] (d/enumerate ids)]
(-> cfg
(assoc ::file-id file-id)
(assoc ::file-seqn index)
(with-outer-counter :files {:current (inc index)
:total (count ids)})
(export-file)))
;; Write manifest file
@ -742,17 +778,19 @@
(defn- read-file-colors
[{:keys [::bfc/input ::entries-index] :as cfg} file-id]
(->> (get-in entries-index [:colors (str file-id)])
(reduce (fn [result {:keys [id entry]}]
(let [object (->> (read-entry cfg input entry)
(decode-color)
(validate-color))]
(events/tap :progress {:section :color :id id :file-id file-id})
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty)))
(let [entries (get-in entries-index [:colors (str file-id)])]
(->> (d/enumerate entries)
(reduce (fn [result [index {:keys [id entry]}]]
(let [object (->> (read-entry cfg input entry)
(decode-color)
(validate-color))]
(tap-progress cfg {:section :color :id id :file-id file-id
:current (inc index) :total (count entries)})
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty))))
(defn- read-file-components
[{:keys [::bfc/input ::entries-index] :as cfg} file-id]
@ -771,15 +809,18 @@
(reduce-kv (fn [objects id shape]
(assoc objects id (bfl/clean-shape-pre-decode shape)))
objects
objects))))]
objects))))
entries
(get-in entries-index [:components (str file-id)])]
(->> (get-in entries-index [:components (str file-id)])
(reduce (fn [result {:keys [id entry]}]
(->> (d/enumerate entries)
(reduce (fn [result [index {:keys [id entry]}]]
(let [object (->> (read-entry cfg input entry)
(clean-component-pre-decode)
(decode-component)
(clean-component-post-decode))]
(events/tap :progress {:section :component :id id :file-id file-id})
(tap-progress cfg {:section :component :id id :file-id file-id
:current (inc index) :total (count entries)})
(if (= id (:id object))
(assoc result id object)
result)))
@ -788,22 +829,24 @@
(defn- read-file-typographies
[{:keys [::bfc/input ::entries-index] :as cfg} file-id]
(->> (get-in entries-index [:typographies (str file-id)])
(reduce (fn [result {:keys [id entry]}]
(let [object (->> (read-entry cfg input entry)
(decode-typography)
(validate-typography))]
(events/tap :progress {:section :typography :id id :file-id file-id})
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty)))
(let [entries (get-in entries-index [:typographies (str file-id)])]
(->> (d/enumerate entries)
(reduce (fn [result [index {:keys [id entry]}]]
(let [object (->> (read-entry cfg input entry)
(decode-typography)
(validate-typography))]
(tap-progress cfg {:section :typography :id id :file-id file-id
:current (inc index) :total (count entries)})
(if (= id (:id object))
(assoc result id object)
result)))
{})
(not-empty))))
(defn- read-file-tokens-lib
[{:keys [::bfc/input ::entries-index] :as cfg} file-id]
(when-let [{:keys [entry]} (first (get-in entries-index [:tokens (str file-id)]))]
(events/tap :progress {:section :tokens-lib :file-id file-id})
(tap-progress cfg {:section :tokens-lib :file-id file-id})
(->> (read-entry cfg input entry nil)
(decode-tokens-lib)
(validate-tokens-lib))))
@ -811,7 +854,7 @@
(defn- read-file-tokens-status
[{:keys [::bfc/input ::entries-index] :as cfg} file-id tokens-lib]
(when-let [{:keys [entry]} (first (get-in entries-index [:tokens-status (str file-id)]))]
(events/tap :progress {:section :tokens-status :file-id file-id})
(tap-progress cfg {:section :tokens-status :file-id file-id})
(->> (read-entry cfg input entry nil)
(cfo/names->ids tokens-lib)
(decode-tokens-status)
@ -833,19 +876,21 @@
(defn- read-file-pages
[{:keys [::bfc/input ::entries-index] :as cfg} file-id]
(->> (get-in entries-index [:pages (str file-id)])
(keep (fn [{:keys [id entry]}]
(let [page (->> (read-entry cfg input entry)
(decode-page))
page (dissoc page :options)]
(events/tap :progress {:section :page :id id :file-id file-id})
(when (= id (:id page))
(let [objects (read-file-shapes cfg file-id id)]
(assoc page :objects objects))))))
(sort-by :index)
(reduce (fn [result {:keys [id] :as page}]
(assoc result id (dissoc page :index)))
(d/ordered-map))))
(let [entries (get-in entries-index [:pages (str file-id)])]
(->> (d/enumerate entries)
(keep (fn [[index {:keys [id entry]}]]
(let [page (->> (read-entry cfg input entry)
(decode-page))
page (dissoc page :options)]
(tap-progress cfg {:section :page :id id :file-id file-id
:current (inc index) :total (count entries)})
(when (= id (:id page))
(let [objects (read-file-shapes cfg file-id id)]
(assoc page :objects objects))))))
(sort-by :index)
(reduce (fn [result {:keys [id] :as page}]
(assoc result id (dissoc page :index)))
(d/ordered-map)))))
(defn- read-file-thumbnails
[{:keys [::bfc/input ::entries-index] :as cfg} file-id]
@ -886,8 +931,11 @@
:plugin-data plugin-data}))
(defn- import-file
[{:keys [::db/conn ::bfc/project-id ::manifest] :as cfg} {file-id :id file-name :name}]
(let [file-id' (bfc/lookup-index file-id)
[{:keys [::db/conn ::bfc/project-id ::manifest] :as cfg}
{file-id :id file-name :name}
position]
(let [cfg (with-outer-counter cfg :files position)
file-id' (bfc/lookup-index file-id)
file (read-file cfg file-id)
media (read-file-media cfg file-id)
thumbnails (read-file-thumbnails cfg file-id)]
@ -899,16 +947,19 @@
:version (:version file)
::l/sync? true)
(tap-progress cfg {:section :file :file-id file-id})
(vswap! bfc/*state* update :index bfc/update-index media :id)
(doseq [item media]
(doseq [[index item] (d/enumerate media)]
(let [params (-> item
(update :id bfc/lookup-index)
(assoc :file-id file-id')
(d/update-when :media-id bfc/lookup-index)
(d/update-when :thumbnail-id bfc/lookup-index))]
(events/tap :progress {:section :media :id (:id params) :file-id file-id})
(tap-progress cfg {:section :media :id (:id params) :file-id file-id
:current (inc index) :total (count media)})
(l/dbg :hint "inserting media object"
:file-id (str file-id')
@ -921,7 +972,7 @@
(db/insert! conn :file-media-object params
::db/on-conflict-do-nothing? (::bfc/overwrite cfg))))
(doseq [item thumbnails]
(doseq [[index item] (d/enumerate thumbnails)]
(let [media-id (bfc/lookup-index (:media-id item))
object-id (-> (assoc item :file-id file-id')
(cth/fmt-object-id))
@ -935,13 +986,12 @@
:media-id (str media-id)
::l/sync? true)
(events/tap :progress {:section :thumbnail :file-id file-id :object-id object-id})
(tap-progress cfg {:section :thumbnail :file-id file-id :object-id object-id
:current (inc index) :total (count thumbnails)})
(db/insert! conn :file-tagged-object-thumbnail params
::db/on-conflict-do-nothing? true)))
(events/tap :progress {:section :file :file-id file-id})
(let [data (-> (read-file-data cfg file-id (:tokens-source file))
(d/without-nils)
(assoc :id file-id')
@ -970,26 +1020,26 @@
(defn- import-file-relations
[{:keys [::db/conn ::manifest ::bfc/timestamp] :as cfg}]
(events/tap :progress {:section :relations})
(doseq [[file-id libr-id] (:relations manifest)]
(let [relations (:relations manifest)]
(doseq [[index [file-id libr-id]] (d/enumerate relations)]
(tap-progress cfg {:section :relations
:current (inc index) :total (count relations)})
(let [file-id (bfc/lookup-index file-id)
libr-id (bfc/lookup-index libr-id)]
(let [file-id (bfc/lookup-index file-id)
libr-id (bfc/lookup-index libr-id)]
(when (and file-id libr-id)
(l/dbg :hint "create file library link"
:file-id (str file-id)
:lib-id (str libr-id)
::l/sync? true)
(let [rel-params {:file-id file-id
:library-file-id libr-id}]
(db/insert! conn :file-library-rel rel-params)
(bfc/upsert-file-library-sync! conn (assoc rel-params :synced-at timestamp)))))))
(when (and file-id libr-id)
(l/dbg :hint "create file library link"
:file-id (str file-id)
:lib-id (str libr-id)
::l/sync? true)
(let [rel-params {:file-id file-id
:library-file-id libr-id}]
(db/insert! conn :file-library-rel rel-params)
(bfc/upsert-file-library-sync! conn (assoc rel-params :synced-at timestamp))))))))
(defn- import-storage-objects
[{:keys [::bfc/input ::entries-index ::bfc/timestamp] :as cfg}]
(events/tap :progress {:section :storage-objects})
;; IMPORTANT: we strongly do not reuse the main connection that can
;; run inside a transaction because the storage upload process can
;; fail in the middle of uploading and leave garbage on the underlying
@ -998,11 +1048,15 @@
;; what the storage subsystem registers in other parallel
;; transaction
(let [storage (sto/resolve cfg)
entries (:objects entries-index)]
entries (:objects entries-index)
total (count entries)]
(doseq [{:keys [id entry]} entries]
(doseq [[index {:keys [id entry]}] (d/enumerate entries)]
(tap-progress cfg {:section :storage-objects
:current (inc index) :total total})
(let [object (-> (read-entry cfg input entry)
(decode-storage-object)
(d/update-when :content-type bfc/normalize-content-type)
(update :bucket d/nilv sto/default-bucket)
(validate-storage-object))
@ -1038,7 +1092,17 @@
:expected-hash (:hash object)
:found-hash (sto/get-hash content))))
(let [params (-> object
(let [clean (when (bfc/svg-object? object)
(let [limit (::max-binary-entry-size cfg)
raw (with-open [istream (cond-> (zip-entry-stream input (get-zip-entry input path))
limit (size-limiting-stream limit (atom 0) path))]
(io/read istream))]
(bfc/sanitize-imported-svg object raw)))
content (if-let [{:keys [bytes hash]} clean]
(-> (sto/content bytes)
(sto/wrap-with-hash hash))
content)
params (-> object
(dissoc :id :size)
(assoc ::sto/content content)
(assoc ::sto/deduplicate? true)
@ -1171,12 +1235,15 @@
(vswap! bfc/*state* update :index assoc old-lib-id library-id)))
(let [files (get manifest :files)
file-ids (reduce (fn [result file]
total (count files)
file-ids (reduce (fn [result [index file]]
(let [name' (get file :name)
file (assoc file :name name')]
(conj result (import-file cfg file))))
file (assoc file :name name')]
(conj result (import-file cfg file
{:current (inc index)
:total total}))))
[]
files)
(d/enumerate files))
;; Build map of file-id to file-name for resolution
files-info (into {} (map (fn [file-id manifest-file]
[file-id (:name manifest-file)])
@ -1247,7 +1314,7 @@
bfc/*reference-file* ref-file]
(import-storage-objects cfg)
(import-file cfg file)
(import-file cfg file {:current 1 :total 1})
(invalidate-thumbnails cfg file-id)
(bfm/apply-pending-migrations! cfg)
@ -1302,7 +1369,7 @@
(cfeat/check-supported-features! features)))
(events/tap :progress {:section :manifest})
(tap-progress cfg {:section :manifest})
(binding [bfc/*state* (volatile! {:media [] :index {}})]
(if (::bfc/file-id cfg)
@ -1355,6 +1422,11 @@
(vreset! ab true)
nil)
(catch clojure.lang.ExceptionInfo cause
(if (= :interrupt (:type (ex-data cause)))
(vreset! ab true)
(throw cause)))
(catch Throwable cause
(vreset! cs cause)
(vreset! ab true)

17
backend/src/app/config.clj
View File

@ -89,6 +89,7 @@
:jobs-lease (ct/duration {:minutes 30})
:jobs-retention (ct/duration {:days 7})
:jobs-user-ttl (ct/duration {:days 7})
:jobs-request-timeout (ct/duration {:minutes 2})
:media-max-file-size (* 1024 1024 30) ; 30MiB
@ -111,6 +112,8 @@
:quotes-upload-sessions-per-profile 5
:quotes-upload-chunks-per-session 20
:quotes-export-jobs-per-profile 10
:quotes-import-jobs-per-profile 10
:upload-max-chunk-size (* 1024 1024 30) ; 30MiB
;; SSRF protection
@ -216,6 +219,7 @@
[:file-clean-delay {:optional true} ::ct/duration]
[:jobs-lease {:optional true} ::ct/duration]
[:jobs-retention {:optional true} ::ct/duration]
[:jobs-user-ttl {:optional true} ::ct/duration]
[:jobs-request-timeout {:optional true} ::ct/duration]
[:telemetry-enabled {:optional true} ::sm/boolean]
[:default-blob-version {:optional true} ::sm/int]
@ -231,10 +235,10 @@
[:audit-log-http-handler-concurrency {:optional true} ::sm/int]
[:default-executor-parallelism {:optional true} ::sm/int] ;; REVIEW
[:scheduled-executor-parallelism {:optional true} ::sm/int] ;; REVIEW
[:worker-default-parallelism {:optional true} ::sm/int]
[:worker-webhook-parallelism {:optional true} ::sm/int]
[:worker-cron-parallelism {:optional true} ::sm/int]
[:worker-binfile-parallelism {:optional true} ::sm/int]
[:database-password {:optional true} [:maybe :string]]
[:database-uri {:optional true} ::sm/uri]
@ -253,6 +257,8 @@
[:quotes-font-variants-per-team {:optional true} ::sm/int]
[:quotes-comment-threads-per-file {:optional true} ::sm/int]
[:quotes-comments-per-file {:optional true} ::sm/int]
[:quotes-export-jobs-per-profile {:optional true} ::sm/int]
[:quotes-import-jobs-per-profile {:optional true} ::sm/int]
[:quotes-snapshots-per-file {:optional true} ::sm/int]
[:quotes-snapshots-per-team {:optional true} ::sm/int]
[:quotes-branches-per-file {:optional true} ::sm/int]
@ -497,6 +503,15 @@
(or (c/get config :jobs-retention)
(ct/duration {:days 7})))
(defn get-jobs-user-ttl
"How long a user-facing job, and the artifact it owns, is kept before
the jobs GC deletes the row and marks the object for the storage GC.
Not the same as `:jobs-retention`, which only sweeps terminal internal
rows."
[]
(or (c/get config :jobs-user-ttl)
(ct/duration {:days 7})))
(defn get
"A configuration getter. Helps code be more testable."
([key]

45
backend/src/app/health.clj Normal file
View File

@ -0,0 +1,45 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns app.health
"Instance availability state.
A single flag tells whether this backend instance is willing to receive
traffic. The readiness endpoint (`/readyz`) reports the instance as
unavailable while the flag is off, so the load balancer removes it from
rotation. Requests already in flight are still served.
The state is a plain global atom and not an Integrant component because
it must also exist on a bare REPL session, which is where the srepl
helpers change it."
(:require
[app.common.logging :as l]))
(defonce state
(atom true))
(defn online?
"Returns true when this instance is able to receive traffic."
[]
@state)
(defn set-offline
"Marks the instance as offline. The `/readyz` endpoint answers 503 until
`set-online` is called again.
Use it to drain the instance from the load balancer before a restart:
the load balancer stops sending new requests and the requests in flight
finish on their own."
[]
(l/inf :hint "instance set offline" :endpoint "/readyz")
(swap! state (constantly false)))
(defn set-online
"Marks the instance as online again, so the load balancer sends it
traffic."
[]
(l/inf :hint "instance set online" :endpoint "/readyz")
(swap! state (constantly true)))

38
backend/src/app/http.clj
View File

@ -55,21 +55,19 @@
(defn sample-worker-metrics
"Publishes the current state of the xnio worker thread pool (the
request dispatch queue and its threads) as gauges."
request dispatch queue and its threads) as gauges. The pool size is the
signal to watch: the busy thread count of this MXBean stays at zero with
threads blocked inside a concurrency limiter, so it is not published."
[metrics ^XnioWorkerMXBean mxbean]
(let [queue-size (.getWorkerQueueSize mxbean)
busy-count (.getBusyWorkerThreadCount mxbean)
pool-size (.getWorkerPoolSize mxbean)
max-size (.getMaxWorkerPoolSize mxbean)]
;; negative values are missing measurements, not zeros: the xnio
;; MXBean may transiently report -1 on the busy thread count.
;; negative values are missing measurements, not zeros: the xnio MXBean
;; may transiently report -1.
(when (>= queue-size 0)
(mtx/run! metrics :id :http-worker-queue-size :val queue-size))
(when (>= busy-count 0)
(mtx/run! metrics :id :http-worker-busy-threads :val busy-count))
(when (>= pool-size 0)
(mtx/run! metrics :id :http-worker-pool-size :val pool-size))
@ -121,26 +119,14 @@
(defn create-metrics-sampler
"Creates a daemon scheduler that periodically samples the state of
the http server and publishes it as metrics. A single thread is used,
and an unexpected error on a single sample does NOT cancel the
subsequent runs."
the http server and publishes it as metrics, in the shape shared by
`app.metrics/create-sampler`: a single thread, and an unexpected error
on one sample does not cancel the following runs."
[^Undertow server metrics]
(let [state (atom {:last-requests 0 :last-errors 0})
scheduler (px/scheduled-executor
:parallelism 1
:factory (px/thread-factory :prefix "penpot/http-metrics/"
:daemon true))
sample (fn sample []
(try
(sample-http-metrics metrics state server)
(finally
;; reschedule even if a single sample fails, so
;; an unexpected error does not cancel the
;; following runs.
(px/schedule scheduler metrics-sample-interval-ms sample))))]
(px/schedule scheduler 0 sample)
scheduler))
(let [state (atom {:last-requests 0 :last-errors 0})]
(mtx/create-sampler metrics-sample-interval-ms
(fn [] (sample-http-metrics metrics state server))
{:name "http-metrics"})))
(defmethod ig/expand-key ::server
[k v]

30
backend/src/app/http/assets.clj
View File

@ -150,14 +150,22 @@
[request]
(some? (request-profile-id request)))
(defn- tempfile-owner-match?
"Check if the request's profile-id matches the tempfile's stored owner.
Returns true if no profile-id was stored (legacy objects)."
(def ^:private owner-scoped-buckets
"Buckets whose objects belong to a profile: a request from anybody else
must not reach them."
#{sto/tempfile-bucket sto/job-resource-bucket})
(defn- owner-match?
"Check that the request belongs to the profile that owns the object.
A missing owner is only tolerated in `tempfile`, where objects predate
the metadata; the `job-resource` bucket always carries one, so an
object without it fails closed."
[obj request]
(let [stored-profile-id (:profile-id (meta obj))
request-profile-id (request-profile-id request)]
(or (nil? stored-profile-id)
(= stored-profile-id request-profile-id))))
(let [stored (-> obj meta :profile-id)
owner (request-profile-id request)
legacy? (= sto/tempfile-bucket (-> obj meta :bucket))]
(or (and legacy? (nil? stored))
(= stored owner))))
(defn- serve-object-measured
"Serve `obj`, recording one asset metric per outcome. A failure is
@ -175,7 +183,9 @@
"Handler that serves storage objects by id.
For non-public buckets (e.g. profile), requires authentication
via session cookie or access token.
For tempfile bucket, also requires ownership (profile-id match)."
For the owner-scoped buckets (tempfile, job-resource), also requires
ownership: the request must come from the profile the object belongs
to."
[{:keys [::sto/storage] :as cfg} request]
(let [id (get-id request)
obj (sto/get-object storage id)]
@ -193,8 +203,8 @@
;; The response stays 404 to avoid leaking existence, but the
;; metric records the internal 401 outcome.
(and (= (-> obj meta :bucket) sto/tempfile-bucket)
(not (tempfile-owner-match? obj request)))
(and (contains? owner-scoped-buckets (-> obj meta :bucket))
(not (owner-match? obj request)))
(do
(emit-asset! cfg "by-id" obj 401)
{::yres/status 404})

27
backend/src/app/http/debug.clj
View File

@ -25,6 +25,7 @@
[app.config :as cf]
[app.db :as db]
[app.features.file-migrations :as feat.fmig]
[app.health :as health]
[app.http.session :as session]
[app.redis :as rds]
[app.rpc.commands.auth :as auth]
@ -857,17 +858,23 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn health-handler
"Mainly a task that performs a health check."
"Mainly a task that performs a health check. When the instance is marked
as offline (see `app.health`), it reports the instance as unavailable
without querying the database, so the load balancer drains it while the
requests in flight are still served."
[{:keys [::db/pool]} _]
(try
(db/exec-one! pool ["select count(*) as count from server_prop;"])
{::yres/status 200
::yres/body "OK"}
(catch Throwable cause
(l/warn :hint "unable to execute query on health handler"
:cause cause)
{::yres/status 503
::yres/body "KO"})))
(if (health/online?)
(try
(db/exec-one! pool ["select count(*) as count from server_prop;"])
{::yres/status 200
::yres/body "OK"}
(catch Throwable cause
(l/warn :hint "unable to execute query on health handler"
:cause cause)
{::yres/status 503
::yres/body "KO"}))
{::yres/status 503
::yres/body "OFFLINE"}))
(defn changelog-handler
[_ _]

15
backend/src/app/http/sse.clj
View File

@ -60,14 +60,13 @@
(partial write! output)
(partial pu/close! output))]
(try
(binding [events/*channel* channel]
(let [result (handler)]
(events/tap :end result)))
(catch Throwable cause
(let [result (errors/handle' cause request)]
(events/tap channel :error result)))
(binding [events/*sink* channel]
(try
(let [result (handler)]
(events/tap :end result))
(catch Throwable cause
(let [result (errors/handle' cause request)]
(events/tap :error result)))))
(finally
(sp/close! channel)
(px/await! listener))))))}))

343
backend/src/app/jobs.clj
View File

@ -9,9 +9,11 @@
Every job is defined as a job-def map returned by the `ig/init-key` of its
module: {::name, ::schema, ::handler, ::decoder, ::validator} — decoder and
validator are precompiled at init time. The registry of job-defs is plain
integrant wiring (::jobs/defs); submit, dispatch and management consume it
by reference.
validator are precompiled at init time. A job-def may also carry the
optional metadata {::family, ::resource-role}, which the consumers of the
job (quotes, storage helpers) read from the registry: the substrate never
reads them. The registry of job-defs is plain integrant wiring (::jobs/defs);
submit, dispatch and management consume it by reference.
Two execution modes are provided:
- `submit` (durable): validates + JSON-encodes params and inserts a row
@ -27,8 +29,10 @@
on its loop, otherwise the dispatcher marks it `aborted` (a system-side
terminal state, like `cancelled` but set by the dispatcher instead of
a user: never retried, kept for triage and reported with an error
log) while its side effects continue. `heartbeat` also accepts an
optional `progress` report, which is stored as a `progress` row of
log) while its side effects continue. A beat that finds the job no
longer active raises an `:interrupt`, an internal signal that the task
should stop the work in course, never an error. `heartbeat` also accepts
an optional `progress` report, which is stored as a `progress` row of
`job_event`: progress is durable history, not a mutable column, and
needs no Redis.
@ -37,7 +41,7 @@
follow the job without polling the database.
Reserved ledger columns (`profile_id`, `error`, `result`, `resource_id`,
`expires_at`) are only written by `submit` (profile and resource
`expires_at`) are only written by `submit` (profile, resource and expiry
references) and by the terminal writers; `submit` never infers them from
`params`."
(:require
@ -82,14 +86,20 @@
whether to schedule again. A handler has no use for the counter, and
the attempt number would lie anyway: the `noop` retry strategy runs
again without incrementing it, so a durable \"which execution is this\"
number would need a second counter that nothing bounds."
number would need a second counter that nothing bounds.
`profile-id` is the owner of a user-facing job and nil for an internal
one. It travels here so a handler can revalidate permissions and check
who owns the resource it is working on without a second query."
[:map {:closed true
:title "job-context"}
[:id ::sm/uuid]
[:name ::sm/text]
[:label [:maybe ::sm/text]]
;; technical reference kept for garbage collection
[:resource-id [:maybe ::sm/uuid]]])
[:resource-id [:maybe ::sm/uuid]]
;; owner of a user-facing job; nil for an internal job
[:profile-id [:maybe ::sm/uuid]]])
(def check-context
"Validate a handler context; raises with the malli explanation when it
@ -97,7 +107,7 @@
(sm/check-fn schema:context))
(defn make-context
"Build the handler context from a job row: exactly the four keys a
"Build the handler context from a job row: exactly the five keys a
handler may see, and nothing else. The result is a plain map, not the
database row, and it is not modified afterwards.
@ -107,7 +117,8 @@
(check-context {:id (:id job)
:name (:name job)
:label (if (str/blank? (:label job)) nil (:label job))
:resource-id (:resource-id job)}))
:resource-id (:resource-id job)
:profile-id (:profile-id job)}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; JOB DEFINITIONS (registry)
@ -123,6 +134,12 @@
(def ^:private schema:job-def
[:map {:title "job-def"}
[::name schema:job-name]
;; Optional metadata of the job family, read from the registry by the
;; consumers that need it (quotes, storage helpers, a future job
;; listing). `app.jobs` itself never reads them: they are not part of
;; the execution contract.
[::family {:optional true} ::sm/keyword]
[::resource-role {:optional true} ::sm/keyword]
[::schema any?]
;; every handler is [context params]. A job-def already closes over its
;; own dependencies, so nothing else is handed to it: a handler cannot
@ -211,9 +228,9 @@
(def ^:private sql:insert-new-job
"insert into job (id, name, tenant, params, queue, label, priority,
max_retries, profile_id, resource_id, created_at,
modified_at, scheduled_at)
values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
max_retries, profile_id, resource_id, expires_at,
created_at, modified_at, scheduled_at)
values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
returning id")
;; `tenant` is part of the match, not an extra: without it this DELETE
@ -228,6 +245,19 @@
AND status = 'new'
AND scheduled_at > ?")
;; The cron no-overlap check and the skip-if-active submit option share
;; this shape: both look for jobs of one tenant with the same name, queue
;; and label that have not reached a terminal state yet. The
;; `job__name_label__idx` partial index serves both queries.
(def ^:private sql:count-active-jobs
"SELECT count(*) AS n
FROM job
WHERE name = ?
AND tenant = ?
AND queue = ?
AND label = ?
AND status IN ('new', 'scheduled', 'running', 'retry')")
(def ^:private schema:options
[:map {:title "submit-options"}
[::name schema:job-name]
@ -238,12 +268,20 @@
[::priority {:optional true} ::sm/int]
[::max-retries {:optional true} ::sm/int]
[::dedupe {:optional true} ::sm/boolean]
;; Skip the insert when a live job already covers the same
;; (tenant, name, queue, label). Requires an explicit label: the
;; default empty one would block every flagged submission at once.
[::skip-if-active {:optional true} ::sm/boolean]
;; Owner of a user-facing job. Its events are published on the msgbus
;; topic of this profile; internal jobs omit it.
[::profile-id {:optional true} ::sm/uuid]
;; Technical reference (storage object) kept for garbage collection. It
;; is a column, never part of `params`, and it is never inferred from it.
[::resource-id {:optional true} ::sm/uuid]])
[::resource-id {:optional true} ::sm/uuid]
;; Retention of the job: when it is set, the jobs GC deletes the row
;; (and reclaims its resource) once the instant has passed. User-facing
;; jobs set it at creation; internal jobs leave it nil.
[::expires-at {:optional true} ::ct/inst]])
(def check-options
(sm/check-fn schema:options))
@ -264,17 +302,40 @@
encodes them as plain JSON and inserts a row into the `job` table.
Fire-and-forget: returns the job id immediately.
The optional ledger columns (`::profile-id`, `::resource-id` and
`::expires-at`) are validated and stored as columns; nothing is inferred
from `params`.
With `::skip-if-active`, the insert is skipped (and `nil` returned)
when a live job (`new`, `scheduled`, `running` or `retry`) already
exists for the same tenant, name, queue and label. The check and the
insert share one transaction. A skip deletes nothing and inserts
nothing; it records a skipped metric instead of a submitted one, so
dashboards can tell withheld work apart from new work. The option
needs an explicit non-blank `::label`, otherwise it raises.
NOTE: the dedupe DELETE and the INSERT run atomically: joined to
the caller's transaction when the cfg provides `::db/conn`, wrapped
in their own transaction otherwise. Concurrent cross-backend
submissions can, in rare race conditions, produce duplicated 'new'
rows (accepted risk, see prod-infra documentation)."
rows (accepted risk, see prod-infra documentation). The same caveat
covers the skip-if-active check: a race between backends can slip
two inserts past the count."
[cfg {:keys [::params ::name ::delay ::queue ::priority ::max-retries
::dedupe ::label ::profile-id ::resource-id]
::dedupe ::skip-if-active ::label
::profile-id ::resource-id ::expires-at]
:or {delay 0 queue :default priority 100 max-retries 3 label ""}
:as options}]
(assert (mtx/instance cfg) "missing ::mtx/metrics on the jobs cfg")
;; Before the schema check so the failure names the option, not the
;; shape: the schema would reject a blank label with a generic
;; "check error" either way.
(when (and skip-if-active (or (not (string? label)) (str/blank? label)))
(ex/raise :type :validation
:code :skip-if-active-requires-label
:hint "skip-if-active requires an explicit non-blank label"
:name (d/name name)))
(check-options options)
(let [job-def (get-job-def (get-defs cfg) name)
params (validate-params job-def params)
@ -302,6 +363,14 @@
;; between backends could create duplicates, but this is
;; acceptable: cross-backend races are rare, jobs are idempotent,
;; and dedupe is best-effort.
;; Skip-if-active is best-effort like dedupe: the count and the
;; insert share this transaction, but a race between backends
;; can still slip two inserts past the count.
active? (fn [conn]
(when skip-if-active
(pos? (or (:n (db/exec-one! conn [sql:count-active-jobs
job-name tenant queue label]))
0))))
insert! (fn [conn]
(let [deleted (when dedupe
;; the DELETE below is intentional:
@ -322,19 +391,29 @@
:replace (or deleted 0))
(db/exec-one! conn [sql:insert-new-job id job-name tenant payload queue
label priority max-retries
profile-id resource-id
profile-id resource-id expires-at
now now scheduled-at])))]
;; Both statements always run inside db/tx-run!: joined to the
;; caller's transaction when the cfg provides a connection,
;; wrapped in their own otherwise (a failed INSERT can never
;; orphan a committed DELETE, even on an autocommit caller conn).
;; A skip returns nil: no DELETE, no INSERT, no submitted metric.
(db/tx-run! cfg
(fn [{:keys [::db/conn]}]
(let [result (insert! conn)]
(db/after-commit
#(metrics/record-submitted cfg job-name queue))
result)))
id))
(if (active? conn)
(do (db/after-commit
#(metrics/record-skipped cfg job-name queue))
(l/trc :hint "submit skipped, active job exists"
:name job-name
:tenant tenant
:queue queue
:label label
:skipped true))
(let [result (insert! conn)]
(db/after-commit
#(metrics/record-submitted cfg job-name queue))
result
id))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; JOB API
@ -348,7 +427,10 @@
(defn- decode-row
[row]
(decode-json-col row :params))
(-> row
(decode-json-col :params)
(decode-json-col :result)
(decode-json-col :error)))
(defn get-job
"Retrieve the job row (with the raw JSON params decoded to a plain map)."
@ -387,52 +469,93 @@
(def ^:private known-retry-reasons
#{"backoff" "noop"})
(def ^:private max-stage-length 250)
(def ^:private max-progress-key-length
"Longest accepted `:stage` or counter key. They name a vocabulary, they
are not a place for data, so the cap only keeps a runaway key out of the
log."
64)
(def schema:progress-counter
"Counter of one scope of a job: `current` is how many units are done and
`total` how many there are, when the worker knows it."
[:map {:closed true
:title "job-progress-counter"}
[:current ::sm/int]
[:total {:optional true} ::sm/int]])
(def schema:progress
"Progress report of a job: `current` is mandatory, `total` and `stage` are
optional, and no other key is accepted. `stage` is a short human label,
not a place for exception messages or params."
"Progress milestone of a job: the activity in course and the counters of
the scopes around it, each one under its own key.
`:stage` is a stable keyword the client resolves (a translation, an
icon...), never a display string, and `:counters` is open on purpose: a
worker reports the scopes it knows and names the counter of the activity
after its own stage, so a client can render `counters[stage]` without a
table of equivalences. Neither is a place for names, params or exception
text: the payload is keywords and integers only."
[:map {:closed true
:title "job-progress"}
[:current ::sm/int]
[:total {:optional true} ::sm/int]
[:stage {:optional true} ::sm/text]])
[:stage ::sm/keyword]
[:counters {:optional true} [:map-of ::sm/keyword schema:progress-counter]]])
(def check-progress
"Validate a progress report against its schema."
"Validate the shape of a progress milestone."
(sm/check-fn schema:progress))
(defn- check-counter
"Check the range rules of one counter: a non-negative `current` and a
positive `total` never lower than its `current`."
[key counter]
(when (neg? (:current counter))
(ex/raise :type :validation
:code :invalid-progress
:hint "progress counter current must not be negative"
:counter key
:progress counter))
(when-let [total (:total counter)]
(when (or (not (pos? total))
(> (:current counter) total))
(ex/raise :type :validation
:code :invalid-progress
:hint "progress counter total must be positive and not lower than current"
:counter key
:progress counter))))
(defn validate-progress
"Check the range rules a schema cannot express: non-negative `current`,
positive `total`, `current` never greater than `total` and a short
`stage`."
"Check what the schema cannot express: non-negative counters, a positive
total never lower than its `current`, and stage and counter keys short
enough to be a name and not a payload."
[progress]
(let [progress (check-progress progress)]
(when (neg? (:current progress))
(ex/raise :type :validation
:code :invalid-progress
:hint "progress current must not be negative"
:progress progress))
(when-let [total (:total progress)]
(when (or (not (pos? total))
(> (:current progress) total))
(doseq [key (cons (:stage progress) (keys (:counters progress)))]
(when (> (count (name key)) max-progress-key-length)
(ex/raise :type :validation
:code :invalid-progress
:hint "progress total must be positive and not lower than current"
:hint (str "progress key must not be longer than "
max-progress-key-length " characters")
:key key
:progress progress)))
(when (and (:stage progress)
(> (count (:stage progress)) max-stage-length))
(ex/raise :type :validation
:code :invalid-progress
:hint (str "progress stage must not be longer than "
max-stage-length " characters")
:progress progress))
(doseq [[key counter] (:counters progress)]
(check-counter key counter))
progress))
(defn decode-progress
"Read back a stored progress payload as a Clojure map: `:stage` and the
counter keys come back as the strings the database holds, so they are
keywordized here, and a payload that is already a map is returned as is."
[progress]
(when (some? progress)
(-> (cond-> progress
(db/pgobject? progress)
(db/decode-json-pgobject))
(d/update-when :stage keyword)
(d/update-when :counters
(fn [counters]
(into {} (map (fn [[k v]] [(keyword k) v])) counters))))))
(def ^:private event-payload-keys
{"start" #{:attempt}
"progress" #{:current :total :stage}
"progress" #{:stage :counters}
"retry" #{:attempt :reason}
"end" #{:outcome}})
@ -490,7 +613,7 @@
:payload payload
:created-at created-at}))
(defn insert-event
(defn- insert-event
"Insert a `job_event` row, then count it and notify after the commit.
Must be called inside a transaction that owns the job row. When the job
@ -501,7 +624,11 @@
The counter also runs after the commit, so a rolled back transaction
never inflates it."
[{:keys [::mbus/msgbus] :as cfg} job-id kind payload]
(let [payload (validate-event-payload kind payload)
(assert (db/connection-map? cfg)
"expected cfg with valid connection: insert-event must run inside a transaction")
(assert (some? db/*after-commit-context*)
"expected transaction context: insert-event must run inside a transaction")
(let [payload (validate-event-payload kind payload)
connectable (db/get-connectable cfg)
profile-id (:profile-id (db/exec-one! connectable [sql:job-event-owner job-id]))]
(when (and profile-id
@ -543,8 +670,14 @@
;; HEARTBEAT / PROGRESS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private heartbeat-interval (ct/duration {:seconds 60}))
(def ^:private progress-interval (ct/duration {:seconds 1}))
(def ^:private heartbeat-interval
;; one second, down from a minute: a heavy job that was cancelled must
;; be seen as gone at its next beat. The price is one `modified_at`
;; touch per beating job per second (60x the old rate): cheap while the
;; only heavy beater runs alone on its queue, revisit if concurrent
;; beating jobs ever grow.
(ct/duration {:seconds 1}))
(def ^:private progress-interval (ct/duration {:millis 200}))
(def ^:private prune-threshold 10000)
(def ^:private prune-window (ct/duration {:hours 1}))
@ -597,6 +730,12 @@
(swap! heartbeats dissoc job-id)
(swap! progresses dissoc job-id))
(def ^:private active-statuses
"The statuses of a job that is still on its way. It mirrors the filter
of the heartbeat and progress writes below: a row outside this set is no
longer active and nothing can report to it."
#{"new" "scheduled" "running" "retry"})
(def ^:private sql:touch-heartbeat
"UPDATE job
SET modified_at = ?
@ -632,6 +771,27 @@
1)
0))))
(defn check-active
"Raise an `:interrupt` when the job is no longer active.
A job is active while its status is one of `active-statuses`; a row
that already reached a terminal state, or that no longer exists, is
not. The status is read from the row, because a write can only tell
that it matched no row, not why.
The interrupt is an internal signal, not an error: the caller is a task
that must stop the work in course. `heartbeat` calls this when one of
its writes finds the job gone, and a caller can also ask explicitly,
which is what the binfile adapter does before and after its run."
[cfg job-id]
(let [job (get-job cfg job-id)]
(when-not (and (some? job) (contains? active-statuses (:status job)))
(ex/raise :type :interrupt
:code :job-interrupted
:hint "the job is no longer active"
:job-id job-id
:status (or (:status job) "gone")))))
(defn heartbeat
"Keep a running job alive and, optionally, report its progress.
@ -642,14 +802,18 @@
- `:progress` optional progress report (see `schema:progress`).
- `::force?` internal: skips only the progress throttle.
Returns the number of durable writes performed, so 0 means the job is
terminal, has no job context, or the throttle did not allow a write.
Returns the number of durable writes performed, so 0 means there was
nothing to write: no job context, or the throttle did not allow it. A
write that finds the job no longer active raises an `:interrupt` (see
`check-active`) instead of counting zero, so a task in course stops at
its next beat.
The `modified_at` touch is throttled to ~60s and the progress event to
~1s: external workers report progress as sparse milestones, while
handlers may beat on every iteration. Both writes go through the
connection pool (`::db/pool` on the cfg), never the caller transaction,
so a beat survives a rollback of the surrounding work.
Both writes go through the connection pool (`::db/pool` on the cfg),
never the caller transaction, so a beat survives a rollback of the
surrounding work: the `modified_at` touch is throttled to ~1s while
progress events go out at up to ~200ms, so the user sees movement
without hammering the row. External workers report progress as sparse
milestones, while handlers may beat on every iteration.
Like every other function here the cfg is a cfg: a bare pool or
connection is a caller bug and is not accommodated.
@ -662,7 +826,7 @@
forced path used by the management API propagates it so the external
worker can retry."
[cfg & {:keys [job-id progress] :as options}]
(let [job-id (or job-id (get cfg ::job-id) *job-id*)
(let [job-id (or job-id (get cfg ::job-id) *job-id*)
;; a malformed report is a caller bug: never swallow it
progress (some-> progress validate-progress)]
(when (uuid? job-id)
@ -671,20 +835,31 @@
force? (boolean (::force? options))
writes (volatile! 0)]
(when (should-write? heartbeats job-id now heartbeat-interval)
(vswap! writes + (touch-job connectable job-id now)))
(let [n (touch-job connectable job-id now)]
;; the touch is conditional on the row still being active: a
;; write that matched no row is what raises the interrupt
(when (zero? n)
(check-active cfg job-id))
(vswap! writes + n)))
(when (and (some? progress)
(or force?
(should-write? progresses job-id now progress-interval)))
(let [store #(report-progress cfg job-id progress)]
(if force?
(vswap! writes + (store))
(try
(vswap! writes + (store))
(catch Throwable cause
(l/err :hint "unable to persist job progress"
:tenant (cf/get :tenant)
:job-id (str job-id)
:cause cause))))))
(let [store #(report-progress cfg job-id progress)
n (if force?
(store)
(try
(store)
(catch Throwable cause
(l/err :hint "unable to persist job progress"
:tenant (cf/get :tenant)
:job-id (str job-id)
:cause cause)
0)))]
;; the raise stays outside the catch above: an interrupt is
;; not a transient failure and must not be swallowed with it
(when (zero? n)
(check-active cfg job-id))
(vswap! writes + n)))
(int @writes)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -724,13 +899,14 @@
nil)))
(defn- record-terminal
"Record the terminal outcome and the total time. Runs after the commit
"Record the total time of a terminal outcome. Runs after the commit
that made the job terminal, so a rolled back transition is never
counted. Takes the cfg and resolves the metrics instance from it, so
the callback is not tied to an instance read at registration time."
counted. The histogram `_count` is the terminal total per outcome:
no separate counter. Takes the cfg and resolves the metrics
instance from it, so the callback is not tied to an instance read
at registration time."
[cfg job outcome]
(when job
(metrics/record-outcome cfg (:name job) (:queue job) outcome)
(when (ct/inst? (:created-at job))
(metrics/record-total
cfg
@ -976,14 +1152,17 @@
"UPDATE job
SET status='cancelled', modified_at=?
WHERE id=?
AND status IN ('new','scheduled','retry')
AND status IN ('new','scheduled','retry','running')
RETURNING id")
(defn cancel
"Cancel a pending job (new/scheduled/retry) and record the `end` event.
"Cancel a pending or running job (new/scheduled/retry/running) and
record the `end` event.
A running or terminal job is left untouched and writes no event. Returns
the number of affected rows."
A running job stops at its next heartbeat: the beat finds no active
row and raises an `:interrupt`, which the runner treats as a normal
stop while the handler rolls back. A terminal job is left untouched
and writes no event. Returns the number of affected rows."
[cfg job-id]
(assert (mtx/instance cfg) "missing ::mtx/metrics on the jobs cfg")
(let [job (get-job cfg job-id)

16
backend/src/app/jobs/metrics.clj
View File

@ -65,19 +65,18 @@
[(name-label name) (queue-label queue)]
1))
(defn record-skipped
[cfg name queue]
(record-count (mtx/instance cfg) :jobs-skipped
[(name-label name) (queue-label queue)]
1))
(defn record-dispatched
[cfg name queue amount]
(record-count (mtx/instance cfg) :jobs-dispatched
[(name-label name) (queue-label queue)]
amount))
(defn record-outcome
[cfg name queue outcome]
(record-count (mtx/instance cfg) :jobs-completed
[(name-label name) (queue-label queue)
(outcome-label outcome)]
1))
(defn record-retry
[cfg name queue reason]
(record-count (mtx/instance cfg) :jobs-retries
@ -172,7 +171,8 @@
[cfg outcome millis]
(let [outcome (str/lower (or (some-> outcome d/name) "error"))
metrics (mtx/instance cfg)]
(record-count metrics :jobs-requests-total [outcome] 1)
;; No separate counter: the timing `_count` is the request total
;; per outcome.
(record-value metrics :jobs-request-timing [outcome]
(max 0 (long millis)))))

152
backend/src/app/jobs/storage.clj Normal file
View File

@ -0,0 +1,152 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.jobs.storage
"Storage helpers for the objects a job owns through `job.resource_id`.
A job resource lives in the `job-resource` bucket and belongs to the
profile that owns the job, so only that profile can read it back (the
asset route checks the owner, not just the session).
The job row is what keeps the object alive: `storage-gc-touched`
freezes it while a row references it and deletes it once no row does,
and the jobs GC marks it as touched when it removes the row. The object
carries no expiry of its own: `expired-at` is stored as `deleted_at`,
which makes the object unreadable from birth, so the retention of the
artifact is the retention of its job."
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.time :as ct]
[app.config :as cf]
[app.db :as db]
[app.storage :as sto]
[app.storage.tmp :as tmp]))
(defn- resource-uri
"The url a user downloads the artifact from. A string, because the
descriptor ends up in the JSON result of the job."
[id]
(cf/get-public-uri "assets/by-id/" (str id)))
(defn put-resource
"Store an artifact of a job in the `job-resource` bucket and return the
descriptor that identifies it.
Named options:
- `:content` the artifact, an `app.storage/content` value built from a
temporary file or from bytes in memory
- `:filename` the name the user will see
- `:mtype` the content type of the artifact
`profile-id` is the owner of the object: the profile that owns the job,
for both the package a job consumes and the artifact it produces.
The object is marked as touched right away, so an artifact that no job
row ever references (a crash between the upload and the completion) is
reclaimed by the storage GC instead of leaking; while a row references
it, `storage-gc-touched` freezes it."
[cfg profile-id {:keys [content filename mtype]}]
(assert (uuid? profile-id) "expected the profile that owns the resource")
(assert (string? mtype) "expected the content type of the resource")
(let [storage (sto/resolve cfg)
object (sto/put-object! storage
{::sto/content content
::sto/touched-at (ct/now)
:bucket sto/job-resource-bucket
:profile-id profile-id
:content-type mtype})]
{:resource-id (:id object)
:resource-uri (resource-uri (:id object))
:filename filename
:mtype mtype
:size (:size object)}))
(defn- check-input
"The object a job consumes must exist, be a job resource and belong to
the profile that owns the job. Raises `:not-found` otherwise: a handler
never reads another profile's package."
[context object]
(when (or (nil? object)
(not= sto/job-resource-bucket (:bucket (meta object)))
(not= (:profile-id context) (:profile-id (meta object))))
(ex/raise :type :not-found
:code :job-resource-not-found
:hint "the input of the job is not available"
:job-id (:id context)
:resource-id (:resource-id context)))
object)
(defn load-input
"Download the package a job consumes to a local temporary file and
return its path, ready for the binfile reader.
An object that was released or expired is already invisible to
`sto/get-object`, so it lands in the same `:not-found` as a missing
one."
[cfg context]
(let [storage (sto/resolve cfg)
resource-id (:resource-id context)
object (check-input context
(when (uuid? resource-id)
(sto/get-object storage resource-id)))]
(if-let [input (sto/get-object-data storage object)]
(tmp/tempfile-from input)
(ex/raise :type :not-found
:code :job-resource-not-found
:hint "the input of the job is not readable"
:job-id (:id context)
:resource-id resource-id))))
(defn release-resource
"Release a job resource.
The object is marked as deleted and, when it belongs to a job, the
row stops pointing at it in the same transaction: a row never
references an object that is already gone, and the foreign key is not
what ends up clearing the reference. A resource no job owns (the
package of a creation that never submitted) is released with a nil
job id, and then no row is touched at all.
Best effort: a failure is logged and never changes the terminal state
of the job, and releasing without a resource is a no-op. Returns true
when the object was marked as deleted or a stale reference was
cleared."
([cfg resource-id]
(release-resource cfg resource-id nil))
([cfg resource-id job-id]
(when (uuid? resource-id)
(try
(db/tx-run!
cfg
(fn [tx-cfg]
(let [storage (sto/resolve tx-cfg ::db/reuse-conn true)
deleted? (sto/del-object! storage resource-id)
;; the job no longer owns the package: the pointer goes with
;; it, so clearing it does not depend on the object being
;; physically deleted later
cleared? (when (some? job-id)
(db/update! tx-cfg :job
{:resource-id nil :modified-at (ct/now)}
["id = ? AND resource_id = ?"
job-id resource-id]
{::db/return-keys [:id]}))]
(or deleted? (some? cleared?)))))
(catch Throwable cause
(l/wrn :hint "unable to release the input of a job"
:job-id (str job-id)
:resource-id (str resource-id)
:cause cause)
false)))))
(defn release-input
"Release the package a job consumed.
Delegates to `release-resource` with the id of the job: the object
and the pointer are dropped together. Best effort, like there."
[cfg context]
(release-resource cfg (:resource-id context) (:id context)))

94
backend/src/app/loggers/audit/archive_task.clj
View File

@ -11,6 +11,7 @@
[app.common.schema :as sm]
[app.common.transit :as t]
[app.common.uri :as u]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.http.client :as http]
@ -79,9 +80,10 @@
"add-member-to-organization"
"add-team-to-organization"
"cancel-organization-invitation"
"change-organization-advanced-permission"
"create-export-binfile-job"
"create-file"
"create-organization"
"create-organization-attribute"
"create-organization-invitation"
"create-project"
"create-team"
@ -89,8 +91,10 @@
"create-team-invitation"
"create-team-invitations"
"create-webhook"
"delete-file"
"delete-font"
"delete-organization"
"delete-organization-member"
"delete-project"
"delete-team"
"delete-team-invitation"
@ -107,6 +111,8 @@
"rename-organization"
"rename-project"
"restore-deleted-team-files"
"success-activate-organization-sso"
"success-apply-organization-sso-changes"
"update-organization-invitation"
"update-organization-permissions"
"update-team-invitation"
@ -115,12 +121,96 @@
"update-team-photo"
"verify-token"})
;; Props id key -> email prop filled from profile.email (nitrate path only).
;; Some producers store ids as UUID strings (e.g. :user-who-send-invitation).
(def ^:private id->email-prop
{:profile-id :profile-email
:user-id :user-email
:member-id :member-email
:user-who-send-invitation :user-who-send-invitation-email})
(defn- collect-team-ids-needing-name
[events]
(into #{}
(comp (map :props)
(keep (fn [props]
(when-let [team-id (and (not (contains? props :team-name))
(uuid/coerce (:team-id props)))]
team-id))))
events))
(defn- collect-profile-ids-needing-email
[events]
(into #{}
(mapcat (fn [{:keys [props]}]
(keep (fn [[id-key email-key]]
(when-not (contains? props email-key)
(uuid/coerce (get props id-key))))
id->email-prop)))
events))
(defn- load-team-names
[conn ids]
(if (seq ids)
(let [arr (db/create-array conn "uuid" ids)
rows (db/exec! conn ["SELECT id, name FROM team WHERE id = ANY(?)" arr])]
(into {} (map (juxt :id :name) rows)))
{}))
(defn- load-profile-emails
[conn ids]
(if (seq ids)
(let [arr (db/create-array conn "uuid" ids)
rows (db/exec! conn ["SELECT id, email FROM profile WHERE id = ANY(?)" arr])]
(into {} (map (juxt :id :email) rows)))
{}))
(defn- maybe-assoc-team-name
[event team-names]
(let [props (:props event)]
(if-let [team-name (and (not (contains? props :team-name))
(when-let [team-id (uuid/coerce (:team-id props))]
(get team-names team-id)))]
(assoc-in event [:props :team-name] team-name)
event)))
(defn- maybe-assoc-emails
[event emails]
(update event :props
(fn [props]
(reduce-kv (fn [props id-key email-key]
(if-let [email (and (not (contains? props email-key))
(when-let [id (uuid/coerce (get props id-key))]
(get emails id)))]
(assoc props email-key email)
props))
props
id->email-prop))))
(defn- enrich-events-for-nitrate
"Enrich allowlisted events before nitrate ingest:
1. Fill missing :team-name from team id (including soft-deleted).
2. Fill missing emails from matching id keys (including soft-deleted
profiles): :profile-email, :user-email, :member-email,
:user-who-send-invitation-email."
[{:keys [::db/conn]} events]
(let [team-ids (collect-team-ids-needing-name events)
profile-ids (collect-profile-ids-needing-email events)
team-names (load-team-names conn team-ids)
emails (load-profile-emails conn profile-ids)]
(mapv (fn [event]
(-> event
(maybe-assoc-team-name team-names)
(maybe-assoc-emails emails)))
events)))
(defn- send-to-nitrate!
[cfg rows]
(when-let [events (->> rows
(filterv #(contains? event-names-for-nitrate (:name %)))
(not-empty))]
(nitrate/call cfg :ingest-audit-log {:events events})))
(nitrate/call cfg :ingest-audit-log
{:events (enrich-events-for-nitrate cfg events)})))
(defn- mark-archived!
[{:keys [::db/conn]} rows]

73
backend/src/app/main.clj
View File

@ -114,17 +114,17 @@
::mdef/labels ["name"]
::mdef/type :histogram}
:rpc-climit-queue
{::mdef/name "penpot_rpc_climit_queue"
::mdef/help "Current number of queued submissions."
:rpc-climit-waiting
{::mdef/name "penpot_rpc_climit_waiting"
::mdef/help "Calls of this limiter name waiting for a permit, on this instance."
::mdef/labels ["name"]
::mdef/type :gauge}
:rpc-climit-permits
{::mdef/name "penpot_rpc_climit_permits"
::mdef/help "Current number of available permits"
::mdef/labels ["name"]
::mdef/type :gauge}
:rpc-climit-rejected
{::mdef/name "penpot_rpc_climit_rejected_total"
::mdef/help "Calls rejected by this limiter, by name and reason."
::mdef/labels ["name" "reason"]
::mdef/type :counter}
:rpc-climit-timing
{::mdef/name "penpot_rpc_climit_timing"
@ -204,11 +204,6 @@
::mdef/help "Current number of queued tasks in the http server xnio worker."
::mdef/type :gauge}
:http-worker-busy-threads
{::mdef/name "penpot_http_worker_busy_threads"
::mdef/help "Current number of busy threads in the http server xnio worker."
::mdef/type :gauge}
:http-worker-pool-size
{::mdef/name "penpot_http_worker_pool_size"
::mdef/help "Current number of threads in the http server xnio worker pool."
@ -240,16 +235,16 @@
::mdef/labels ["name" "queue"]
::mdef/type :counter}
:jobs-dispatched
{::mdef/name "penpot_jobs_dispatched_total"
::mdef/help "Total number of jobs pushed to a worker queue."
:jobs-skipped
{::mdef/name "penpot_jobs_skipped_total"
::mdef/help "Total number of durable job submissions skipped by skip-if-active."
::mdef/labels ["name" "queue"]
::mdef/type :counter}
:jobs-completed
{::mdef/name "penpot_jobs_completed_total"
::mdef/help "Total number of durable jobs reaching a terminal state."
::mdef/labels ["name" "queue" "outcome"]
:jobs-dispatched
{::mdef/name "penpot_jobs_dispatched_total"
::mdef/help "Total number of jobs pushed to a worker queue. Counts pushes, not claims: compare with the _count of penpot_jobs_queue_wait_ms."
::mdef/labels ["name" "queue"]
::mdef/type :counter}
:jobs-retries
@ -277,7 +272,7 @@
:jobs-queue-wait-timing
{::mdef/name "penpot_jobs_queue_wait_ms"
::mdef/help "Time from job scheduling to worker claim (milliseconds)."
::mdef/help "Time from job scheduling to worker claim (milliseconds). Its _count counts claims, not pushes: compare with penpot_jobs_dispatched_total."
::mdef/labels ["name" "queue"]
::mdef/type :histogram
::mdef/buckets [1 10 50 100 500 1000 5000 10000 30000 60000 300000 600000]}
@ -291,7 +286,7 @@
:jobs-total-timing
{::mdef/name "penpot_jobs_total_ms"
::mdef/help "Time from job creation to a terminal state (milliseconds)."
::mdef/help "Time from job creation to a terminal state (milliseconds). Its _count is the terminal total per outcome."
::mdef/labels ["name" "queue" "outcome"]
::mdef/type :histogram
::mdef/buckets [10 50 100 500 1000 5000 10000 30000 60000 300000 600000 3600000]}
@ -340,15 +335,9 @@
::mdef/labels ["outcome" "reason"]
::mdef/type :counter}
:jobs-requests-total
{::mdef/name "penpot_jobs_requests_total"
::mdef/help "Total number of ephemeral job request events."
::mdef/labels ["outcome"]
::mdef/type :counter}
:jobs-request-timing
{::mdef/name "penpot_jobs_request_ms"
::mdef/help "Time spent waiting for an ephemeral job reply (milliseconds)."
::mdef/help "Time spent waiting for an ephemeral job reply (milliseconds). Its _count is the request total per outcome."
::mdef/labels ["outcome"]
::mdef/type :histogram
::mdef/buckets [1 10 50 100 500 1000 5000 10000 30000 60000 300000]}})
@ -590,6 +579,8 @@
:file-gc (ig/ref :app.tasks.file-gc/job-def)
:offload-file-data (ig/ref :app.tasks.offload-file-data/job-def)
:objects-gc (ig/ref :app.tasks.objects-gc/job-def)
:export-binfile (ig/ref :app.tasks.export-binfile/job-def)
:import-binfile (ig/ref :app.tasks.import-binfile/job-def)
:storage-gc-deleted (ig/ref ::sto.gc-deleted/job-def)
:storage-gc-touched (ig/ref ::sto.gc-touched/job-def)
:storage-pending-gc (ig/ref ::sto.pending-gc/job-def)
@ -642,6 +633,19 @@
::sto/storage (ig/ref ::sto/storage)
::mtx/metrics (ig/ref ::mtx/metrics)}
:app.tasks.export-binfile/job-def
{::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)
::mtx/metrics (ig/ref ::mtx/metrics)
;; the job belongs to a profile, so its events are published
::mbus/msgbus (ig/ref ::mbus/msgbus)}
:app.tasks.import-binfile/job-def
{::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)
::mtx/metrics (ig/ref ::mtx/metrics)
::mbus/msgbus (ig/ref ::mbus/msgbus)}
:app.storage.gc-deleted/job-def
{::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)
@ -840,6 +844,17 @@
::db/pool (ig/ref ::db/pool)
::mbus/msgbus (ig/ref ::mbus/msgbus)}
;; the heavy work of a user job does not share the default runner
[::binfile ::wrk/runner]
{::wrk/parallelism (cf/get :worker-binfile-parallelism 1)
::wrk/queue :binfile
::wrk/tenant (cf/get :tenant)
::rds/client (ig/ref ::rds/client)
::jobs/defs (ig/ref ::jobs/defs)
::mtx/metrics (ig/ref ::mtx/metrics)
::db/pool (ig/ref ::db/pool)
::mbus/msgbus (ig/ref ::mbus/msgbus)}
[::cron ::wrk/runner]
{::wrk/parallelism (cf/get :worker-cron-parallelism 2)
::wrk/queue :cron

57
backend/src/app/media/svg.clj
View File

@ -52,30 +52,47 @@
(def ^:private dangerous-attrs-pattern #"(?i)^on\w+$")
(def ^:private javascript-href-pattern #"(?i)^javascript:")
(def ^:private dangerous-tags
#{"script" "foreignObject" "set"
"animate" "animateTransform" "animateColor" "animateMotion"})
(defn- local-name
"Return the local name of a parsed tag or attribute keyword.
The XML parser interns qualified names with the prefix included in
the keyword name and no keyword namespace: `<x:script>` parses as
the keyword `:x:script`. Dangerous elements and attributes behave
the same in the browser regardless of the prefix used, so matching
is done on the local name: the part after the last `:`."
[k]
(let [n (name k)]
(if (str/includes? n ":")
(last (str/split n ":"))
n)))
(defn- sanitize-svg-element
"Recursively sanitize an SVG element by removing dangerous tags and attributes."
[{:keys [tag attrs content] :as element}]
(when (and (map? element) tag)
(let [dangerous-tags #{:script :foreignObject :set :animate :animateTransform :animateColor :animateMotion}]
(when-not (contains? dangerous-tags tag)
(let [clean-attrs (->> attrs
(remove (fn [[k v]]
(or (re-matches dangerous-attrs-pattern (name k))
(and (#{:href :xlink:href} k)
(string? v)
(re-find javascript-href-pattern (str/trim v))))))
(into {}))
clean-content (when content
(->> content
(filter #(or (string? %) (map? %)))
(map (fn [child]
(if (map? child)
(sanitize-svg-element child)
child)))
(filter some?)
vec))]
(cond-> {:tag tag :attrs clean-attrs}
(seq clean-content) (assoc :content clean-content)))))))
(when-not (contains? dangerous-tags (local-name tag))
(let [clean-attrs (->> attrs
(remove (fn [[k v]]
(or (re-matches dangerous-attrs-pattern (local-name k))
(and (= "href" (local-name k))
(string? v)
(re-find javascript-href-pattern (str/trim v))))))
(into {}))
clean-content (when content
(->> content
(filter #(or (string? %) (map? %)))
(map (fn [child]
(if (map? child)
(sanitize-svg-element child)
child)))
(filter some?)
vec))]
(cond-> {:tag tag :attrs clean-attrs}
(seq clean-content) (assoc :content clean-content))))))
(defn sanitize-svg
"Sanitize SVG content by removing dangerous elements and attributes.

30
backend/src/app/metrics.clj
View File

@ -11,7 +11,8 @@
[app.common.logging :as l]
[app.common.schema :as sm]
[app.metrics.definition :as-alias mdef]
[integrant.core :as ig])
[integrant.core :as ig]
[promesa.exec :as px])
(:import
io.prometheus.client.CollectorRegistry
io.prometheus.client.Counter
@ -203,6 +204,33 @@
(report-safe-failure! (str "unable to record metric " (pr-str id)) cause)
nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SAMPLER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn create-sampler
"Create a daemon scheduler that runs `sample` every `interval-ms`,
starting right away. A single thread is used, named after `name`
(default `metrics`), and an unexpected error on a single sample does NOT
cancel the following runs: the next run is scheduled in a `finally`.
The caller owns the returned scheduler and has to shut it down
(`px/shutdown-now`) when its component halts."
([interval-ms sample]
(create-sampler interval-ms sample {}))
([interval-ms sample {:keys [name] :or {name "metrics"}}]
(let [prefix (str "penpot/" name "/")
scheduler (px/scheduled-executor
:parallelism 1
:factory (px/thread-factory :prefix prefix :daemon true))
task (fn task []
(try
(sample)
(finally
(px/schedule scheduler interval-ms task))))]
(px/schedule scheduler 0 task)
scheduler)))
(defn- create-registry
[]
(let [registry (CollectorRegistry.)]

6
backend/src/app/migrations.clj
View File

@ -519,6 +519,12 @@
{:name "0156-add-storage-object-json-dedup-index"
:fn (mg/resource "app/migrations/sql/0156-add-storage-object-json-dedup-index.sql")}
{:name "0153-del-orphan-profile-rels-after-team-leave"
:fn (mg/resource "app/migrations/sql/0153-del-orphan-profile-rels-after-team-leave.sql")}
{:name "0154-del-legacy-file-object-thumbnail-table"
:fn (mg/resource "app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql")}
{:name "0155-add-file-branch-table"
:fn (mg/resource "app/migrations/sql/0155-add-file-branch-table.sql")}

27
backend/src/app/migrations/sql/0153-del-orphan-profile-rels-after-team-leave.sql Normal file
View File

@ -0,0 +1,27 @@
-- Remove team-scoped role rows whose profile is no longer a member of
-- the team that owns the project/file. Leftover from before
-- leave-team/delete-team-member cleaned them up (GHSA-v9r9-h77c-55m2).
-- Rows with a live team membership are kept.
DELETE FROM file_profile_rel AS fpr
USING file AS f
INNER JOIN project AS p ON (p.id = f.project_id)
WHERE fpr.file_id = f.id
AND NOT EXISTS (SELECT 1
FROM team_profile_rel AS tpr
WHERE tpr.team_id = p.team_id
AND tpr.profile_id = fpr.profile_id);
DELETE FROM project_profile_rel AS ppr
USING project AS p
WHERE ppr.project_id = p.id
AND NOT EXISTS (SELECT 1
FROM team_profile_rel AS tpr
WHERE tpr.team_id = p.team_id
AND tpr.profile_id = ppr.profile_id);
DELETE FROM team_project_profile_rel AS tppr
WHERE NOT EXISTS (SELECT 1
FROM team_profile_rel AS tpr
WHERE tpr.team_id = tppr.team_id
AND tpr.profile_id = tppr.profile_id);

7
backend/src/app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql Normal file
View File

@ -0,0 +1,7 @@
--- The `file_object_thumbnail` table was replaced by
--- `file_tagged_object_thumbnail` and nothing references it anymore: no query
--- in the codebase touches it and it is empty in production.
---
--- NOTE: the storage bucket named "file-object-thumbnail" (the one used by
--- `file_tagged_object_thumbnail`) has nothing to do with this table and stays.
DROP TABLE IF EXISTS file_object_thumbnail;

28
backend/src/app/nitrate.clj
View File

@ -265,7 +265,7 @@
(request-to-nitrate cfg :get
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"members/"
profile-id)
schema:profile-organization params))
@ -275,7 +275,7 @@
(request-to-nitrate cfg :get
(generate-nitrate-uri
"api/teams/"
team-id
(str team-id "/")
"users/"
profile-id)
schema:profile-organization params))
@ -285,7 +285,7 @@
(request-to-nitrate cfg :get
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"summary")
schema:organization-summary params))
@ -294,7 +294,7 @@
(request-to-nitrate cfg :get
(generate-nitrate-uri
"api/users/"
profile-id
(str profile-id "/")
"owned-organizations")
[:vector schema:organization-summary]
params))
@ -314,7 +314,7 @@
(let [organizations (request-to-nitrate cfg :get
(generate-nitrate-uri
"api/users/"
profile-id
(str profile-id "/")
"owned-organizations-summary")
[:vector schema:organization-summary-counts]
params)]
@ -329,7 +329,7 @@
(request-to-nitrate cfg :post
(generate-nitrate-uri
"api/users/"
profile-id
(str profile-id "/")
"cleanup-after-deletion")
nil params))
@ -340,7 +340,7 @@
team (request-to-nitrate cfg :post
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"add-team")
cto/schema:team-with-organization params)
custom-photo (when-let [logo-id (dm/get-in team [:organization :logo-id])]
@ -357,7 +357,7 @@
(request-to-nitrate cfg :post
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"add-user")
schema:profile-organization params)))
@ -372,7 +372,7 @@
(request-to-nitrate cfg :post
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"remove-user")
nil params)))
@ -382,7 +382,7 @@
(request-to-nitrate cfg :post
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"remove-team")
nil params)))
@ -439,7 +439,7 @@
(request-to-nitrate cfg :get
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"permissions")
[:map
[:organization-id ::sm/uuid]
@ -453,7 +453,7 @@
(request-to-nitrate cfg :get
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"sso")
schema:nitrate-sso
params))
@ -461,7 +461,7 @@
(defn- get-organization-sso-by-team-api
[cfg {:keys [team-id] :as params}]
(request-to-nitrate cfg :get
(generate-nitrate-uri "api/teams/" team-id "sso")
(generate-nitrate-uri "api/teams/" (str team-id "/") "sso")
schema:nitrate-sso
params))
@ -470,7 +470,7 @@
(request-to-nitrate cfg :get
(generate-nitrate-uri
"api/organizations/"
organization-id
(str organization-id "/")
"members-list")
[:vector ::sm/uuid]
params))

1
backend/src/app/rpc.clj
View File

@ -381,6 +381,7 @@
'app.rpc.commands.files-branch
'app.rpc.commands.files-pull-request
'app.rpc.commands.files-thumbnails
'app.rpc.commands.jobs
'app.rpc.commands.ldap
'app.rpc.commands.management
'app.rpc.commands.media

256
backend/src/app/rpc/climit.clj
View File

@ -21,10 +21,12 @@
[clojure.set :as set]
[datoteka.fs :as fs]
[integrant.core :as ig]
[promesa.exec :as px]
[promesa.exec.bulkhead :as pbh])
(:import
clojure.lang.ExceptionInfo
java.util.concurrent.atomic.AtomicLong))
java.util.concurrent.atomic.AtomicLong
java.util.concurrent.ConcurrentHashMap))
(set! *warn-on-reflection* true)
@ -54,6 +56,71 @@
(def ^:private check-config
(sm/check-fn schema:config))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WAITING COUNTER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private waiting-sample-interval-ms 15000)
(defn- create-waiting-counters
"Per limiter name, how many calls on this instance are waiting for a
permit. Every limiter of a name adds to the same entry, so the value does
not depend on which of them ran last the way a sampled gauge does: a
request that enters and never leaves stays visible for ever. The map
belongs to the component, so its counts die with it instead of surviving
into the next system built in the same JVM."
[]
(ConcurrentHashMap.))
(defn- waiting-counter
^AtomicLong
[^ConcurrentHashMap counters name]
(.computeIfAbsent counters name
(reify java.util.function.Function
(apply [_ _] (AtomicLong. 0)))))
(defn- publish-waiting
[metrics name value]
(mtx/run! metrics
:id :rpc-climit-waiting
:val value
:labels (into-array String [name])))
(defn- waiting-inc
[metrics counters name]
(publish-waiting metrics name (.incrementAndGet (waiting-counter counters name))))
(defn- waiting-dec
[metrics counters name]
(publish-waiting metrics name (.decrementAndGet (waiting-counter counters name))))
(defn- republish-waiting
"Publish the waiting count of every name again. A count that stops changing
(a limiter whose requests never come back and whose traffic died) has to keep
being written, or the series goes stale and the pile-up disappears."
[metrics counters]
(doseq [[name counter] counters]
(publish-waiting metrics name (.get ^AtomicLong counter))))
(defn- create-waiting-sampler
"A daemon sampler that republishes the waiting counts of this component."
[metrics counters]
(mtx/create-sampler waiting-sample-interval-ms
(fn [] (republish-waiting metrics counters))
{:name "climit-metrics"}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defrecord ConcurrencyLimiter [params cache metrics counters sampler]
IConcurrencyLimiter
(get-config [_ id]
(get params id))
(invoke [_ config handler]
(impl-invoke metrics counters cache config handler)))
(def ^:private schema:climit-params
[:map
::mtx/metrics
@ -70,19 +137,24 @@
(when enabled
(when-let [params (some->> config slurp edn/read-string check-config)]
(l/inf :hint "initializing concurrency limit" :config (str config))
(let [params (reduce-kv (fn [result k v]
(assoc result k (assoc v ::id k)))
params
params)
cache (create-cache cfg)]
(let [params (reduce-kv (fn [result k v]
(when-not (:timeout v)
(l/wrn :hint "limiter without timeout, a saturated one parks its threads forever"
:id k))
(assoc result k (assoc v ::id k)))
params
params)
cache (create-cache cfg)
counters (create-waiting-counters)]
(reify
IConcurrencyLimiter
(get-config [_ id]
(get params id))
(->ConcurrencyLimiter params cache metrics counters
(create-waiting-sampler metrics counters))))))
(invoke [_ config handler]
(impl-invoke metrics cache config handler)))))))
(defmethod ig/halt-key! ::rpc/climit
[_ instance]
(when-let [sampler (:sampler instance)]
(l/inf :hint "stopping concurrency limit metrics")
(px/shutdown-now sampler)))
(defn- id->str
([id]
@ -110,28 +182,15 @@
:keepalive "5m")))
(defn- measure
[metrics mlabels stats elapsed]
(let [mpermits (:max-permits stats)
permits (:permits stats)
queue (:queue stats)
queue (- queue mpermits)
queue (if (neg? queue) 0 queue)]
(mtx/run! metrics
:id :rpc-climit-queue
:val queue
:labels mlabels)
(mtx/run! metrics
:id :rpc-climit-permits
:val permits
:labels mlabels)
(when elapsed
(mtx/run! metrics
:id :rpc-climit-timing
:val (inst-ms elapsed)
:labels mlabels))))
"Publish the wait time of a call that got its permit, in milliseconds. The
queue is not published here: a gauge written by whichever limiter of the name
ran last cannot show it, and the `:rpc-climit-waiting` gauge accumulates the
entries and the exits instead."
[metrics mlabels elapsed]
(mtx/run! metrics
:id :rpc-climit-timing
:val (inst-ms elapsed)
:labels mlabels))
(defn- prepare-params-for-debug
[params]
@ -140,7 +199,7 @@
(update-vals str)))
(defn- log
[action req-id stats limit-id limit-label limit-params elapsed]
[{:keys [id label params permits queue-max]} action req-id stats elapsed code reason]
(let [mpermits (:max-permits stats)
queue (:queue stats)
queue (- queue mpermits)
@ -150,58 +209,109 @@
(l/log level
:hint action
:req req-id
:id limit-id
:label limit-label
:id id
:label label
:queue queue
:queue-max queue-max
:permits permits
:elapsed (some-> elapsed ct/format-duration)
:params @limit-params)))
:code code
:reason reason
:params @params)))
(def ^:private idseq (AtomicLong. 0))
(def ^:private ^ThreadLocal held-limiters
;; Limiters a thread is inside of, identified by the limiter instance, which
;; already encodes the limit id and its key: the cache is per id+key pair.
;; `pbh/invoke!` runs the handler on the calling thread, so a handler that
;; enters climit again for a limit it holds finds it here. Without this a
;; thread parks forever behind a permit it holds itself.
(ThreadLocal/withInitial
(reify java.util.function.Supplier
(get [_] (java.util.HashSet.)))))
(defn- impl-invoke
[metrics cache config handler]
[metrics counters cache config handler]
(let [limit-id (::id config)
limit-key (::key config)
limit-label (::label config)
limit-name (id->str limit-id)
limit-params (delay
(prepare-params-for-debug
(::params config)))
mlabels (into-array String [(id->str limit-id)])
limit-id (id->str limit-id limit-key)
limiter (cache/get cache limit-id (partial create-limiter config))
tpoint (ct/tpoint)
req-id (.incrementAndGet ^AtomicLong idseq)]
(try
(let [stats (pbh/get-stats limiter)]
(measure metrics mlabels stats nil)
(log "enqueued" req-id stats limit-id limit-label limit-params nil))
mlabels (into-array String [limit-name])
limit-id (id->str limit-id limit-key)
limit {:id limit-id
:label limit-label
:params limit-params
:permits (or (:permits config) (:concurrency config) 1)
:queue-max (or (:queue config) (:queue-size config))}
limiter (cache/get cache limit-id (partial create-limiter config))
held ^java.util.Set (.get ^ThreadLocal held-limiters)]
(pbh/invoke! limiter (fn []
(let [elapsed (tpoint)
stats (pbh/get-stats limiter)]
(measure metrics mlabels stats elapsed)
(log "acquired" req-id stats limit-id limit-label limit-params elapsed)
(handler))))
(if (.contains held limiter)
;; The calling thread already holds this limiter for this key: run the
;; handler inline instead of queueing behind itself.
(do
(l/trc :hint "reentrant invocation" :id limit-id :label limit-label)
(handler))
(catch ExceptionInfo cause
(let [{:keys [type code]} (ex-data cause)]
(if (= :bulkhead-error type)
(let [tpoint (ct/tpoint)
req-id (.incrementAndGet ^AtomicLong idseq)
waiting (volatile! true)
stop-waiting (fn []
;; Exactly one decrement per increment: the flag
;; makes a second call a no-op and the `finally`
;; guarantees that there is one.
(when @waiting
(vreset! waiting false)
(waiting-dec metrics counters limit-name)))]
(.add held limiter)
(try
;; The increment lives inside the `try`, so a throwable from the
;; publishing path unwinds through the `finally`: the thread drops the
;; mark and the count comes back down instead of staying up for good.
(waiting-inc metrics counters limit-name)
(let [stats (pbh/get-stats limiter)]
(log limit "enqueued" req-id stats nil nil nil))
(pbh/invoke! limiter (fn []
(stop-waiting)
(let [elapsed (tpoint)
stats (pbh/get-stats limiter)]
(measure metrics mlabels elapsed)
(log limit "acquired" req-id stats elapsed nil nil)
(handler))))
(catch ExceptionInfo cause
(let [{:keys [type code] :as data} (ex-data cause)]
(if (= :bulkhead-error type)
(let [elapsed (tpoint)
stats (pbh/get-stats limiter)
reason (if (some? (:timeout data)) "timeout" "queue-full")]
(mtx/run! metrics
:id :rpc-climit-rejected
:inc 1
:labels (into-array String [limit-name reason]))
(log limit "rejected" req-id stats elapsed code reason)
(ex/raise :type :concurrency-limit
:code code
:hint "concurrency limit reached"
:cause cause))
(throw cause))))
(finally
(.remove held limiter)
(stop-waiting)
(let [elapsed (tpoint)
stats (pbh/get-stats limiter)]
(log "rejected" req-id stats limit-id limit-label limit-params elapsed)
(ex/raise :type :concurrency-limit
:code code
:hint "concurrency limit reached"
:cause cause))
(throw cause))))
(finally
(let [elapsed (tpoint)
stats (pbh/get-stats limiter)]
(measure metrics mlabels stats nil)
(log "finished" req-id stats limit-id limit-label limit-params elapsed))))))
(log limit "finished" req-id stats elapsed nil nil))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MIDDLEWARE
@ -263,7 +373,13 @@
(l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
handler)))
handler
(concat global-limits (get-limits mdata)))
;; The root limiters go last so they end up outermost: every path
;; meets them before the command's own limits. The nested
;; `climit/invoke!` chains carry only the command's own limits and
;; run inside those of the enclosing call, so this puts both paths
;; in the same order. With the opposite order two calls of the same
;; profile hold the same limiters inverted and park for good.
(concat (get-limits mdata) global-limits))
handler))

3
backend/src/app/rpc/commands/audit.clj
View File

@ -162,8 +162,7 @@
[:events [:vector schema:frontend-event]]])
(sv/defmethod ::push-audit-events
{::climit/id :submit-audit-events/by-profile
::climit/key-fn ::rpc/profile-id
{::climit/id [[:submit-audit-events/by-profile ::rpc/profile-id]]
::sm/params schema:push-audit-events
::audit/skip true
::doc/skip true

39
backend/src/app/rpc/commands/binfile.clj
View File

@ -10,7 +10,6 @@
[app.binfile.common :as bfc]
[app.binfile.v1 :as bf.v1]
[app.binfile.v3 :as bf.v3]
[app.common.features :as cfeat]
[app.common.schema :as sm]
[app.common.time :as ct]
[app.common.uri :as u]
@ -47,19 +46,12 @@
[:embed-assets {:optional true} ::sm/boolean]])
(defn- export-binfile
[{:keys [::sto/storage] :as cfg} {:keys [type file-id include-libraries embed-assets]}]
(let [output (tmp/tempfile*)
;; Convert legacy boolean flags to unified export-type
export-type (cond
(some? type) type
(true? include-libraries) :include-libraries
(true? embed-assets) :merge-libraries
:else :detach-libraries)]
[{:keys [::sto/storage] :as cfg} {:keys [file-id] :as params}]
(let [output (tmp/tempfile*)]
(try
(-> cfg
(assoc ::bfc/ids #{file-id})
(assoc ::bfc/export-type export-type)
(-> (bfc/export-cfg cfg {:ids #{file-id}
:export-type (bfc/resolve-export-type params)})
(bf.v3/export-files! output))
(let [data (sto/content output)
@ -98,22 +90,13 @@
:project-id project-id)
cfg
(-> cfg
(assoc ::bfc/features (cfeat/get-team-enabled-features cf/flags team))
(assoc ::bfc/project-id project-id)
(assoc ::bfc/profile-id profile-id)
(assoc ::bfc/team-id (:id team))
(assoc ::bfc/name name)
(assoc ::bfc/import-max-binary-entry-size (cf/get :binfile-import-max-binary-entry-size))
(assoc ::bfc/import-max-text-entry-size (cf/get :binfile-import-max-text-entry-size))
(assoc ::bfc/import-max-text-total-size (cf/get :binfile-import-max-text-total-size))
(assoc ::bfc/import-max-zip-entries (cf/get :binfile-import-max-zip-entries)))
(bfc/import-cfg cfg {:profile-id profile-id
:project-id project-id
:team team
:name name
:input (:path file)})
input-path (:path file)
owned? (some? upload-id)
cfg
(assoc cfg ::bfc/input input-path)
owned? (some? upload-id)
result
(try
@ -126,7 +109,7 @@
:version version})))
(finally
(when owned?
(fs/delete input-path))))]
(fs/delete (:path file)))))]
(db/update! pool :project
{:modified-at (ct/now)}

93
backend/src/app/rpc/commands/files.clj
View File

@ -22,6 +22,7 @@
[app.common.transit :as t]
[app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf]
[app.common.types.plugins :as ctpg]
[app.common.types.tokens-lib :as ctob]
[app.common.uri :as uri]
[app.config :as cf]
@ -726,6 +727,53 @@
(get-file-stats cfg id))
;; --- COMMAND QUERY: get-file-plugin-data
(def ^:private schema:get-file-plugin-data
[:map {:title "get-file-plugin-data"}
[:id ::sm/uuid]
[:namespace {:optional true} :keyword]])
(sv/defmethod ::get-file-plugin-data
"Return the file-level plugin data: the arbitrary key/value metadata
stored on the file root through the Plugin API. Optionally narrowed
to a single `namespace`. Lets external tooling read metadata such as
issue or commit references without downloading the whole file."
{::doc/added "2.20"
::sm/params schema:get-file-plugin-data
::sm/result ctpg/schema:plugin-data
::db/transaction true}
[{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id namespace]}]
(check-read-permissions! conn profile-id id)
(let [plugin-data (-> (bfc/get-file cfg id)
(get-in [:data :plugin-data]))]
(if namespace
(select-keys plugin-data [namespace])
(or plugin-data {}))))
;; --- COMMAND QUERY: get-file-tokens
(def ^:private schema:get-file-tokens
[:map {:title "get-file-tokens"}
[:file-id ::sm/uuid]])
(sv/defmethod ::get-file-tokens
"Return the design tokens of a file as a DTCG document, or nil when
the file has none. Active themes and sets come from the file's
tokens status. Cheap alternative to `get-file` when only the tokens
are needed."
{::doc/added "2.20"
::sm/params schema:get-file-tokens
::sm/result [:maybe [:map-of :string :any]]}
[cfg {:keys [::rpc/profile-id file-id]}]
(bfc/check-file-exists cfg file-id)
(check-read-permissions! cfg profile-id file-id)
(let [{:keys [data]} (bfc/get-file cfg file-id)]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(when-let [tokens-lib (cfo/get-tokens-lib data)]
(ctob/export-dtcg-json tokens-lib (cfo/get-tokens-status data))))))
;; --- COMMAND QUERY: get-file-libraries
(def ^:private schema:get-file-libraries
@ -1129,7 +1177,8 @@
:profile-id profile-id})
(rph/with-meta (rph/wrap)
{::audit/props {:project-id (:project-id file)
{::audit/props {:team-id (:id team)
:project-id (:project-id file)
:name (:name file)
:created-at (:created-at file)
:modified-at (:modified-at file)}})))
@ -1368,6 +1417,40 @@
"UPDATE file_tagged_object_thumbnail SET deleted_at = null
WHERE file_id = ANY(?::uuid[])")
(def ^:private sql:restore-storage-objects
"WITH ids AS (SELECT unnest(?::uuid[]) AS file_id)
UPDATE storage_object
SET deleted_at = null
WHERE deleted_at IS NOT NULL
AND (id IN (SELECT media_id
FROM file_media_object AS fmo
JOIN ids ON (ids.file_id = fmo.file_id)
WHERE fmo.deleted_at IS NULL
AND fmo.media_id IS NOT NULL
UNION
SELECT thumbnail_id
FROM file_media_object AS fmo
JOIN ids ON (ids.file_id = fmo.file_id)
WHERE fmo.deleted_at IS NULL
AND fmo.thumbnail_id IS NOT NULL
UNION
SELECT ft.media_id
FROM file_thumbnail AS ft
JOIN ids ON (ids.file_id = ft.file_id)
WHERE ft.deleted_at IS NULL
AND ft.media_id IS NOT NULL
UNION
SELECT fot.media_id
FROM file_tagged_object_thumbnail AS fot
JOIN ids ON (ids.file_id = fot.file_id)
WHERE fot.deleted_at IS NULL
AND fot.media_id IS NOT NULL)
OR id::text IN (SELECT fd.metadata->>'storage-ref-id'
FROM file_data AS fd
JOIN ids ON (ids.file_id = fd.file_id)
WHERE fd.deleted_at IS NULL))")
(defn- restore-files
[conn file-ids]
(let [file-ids (db/create-array conn "uuid" file-ids)]
@ -1376,7 +1459,13 @@
(db/exec-one! conn [sql:restore-file-changes file-ids])
(db/exec-one! conn [sql:restore-file-data file-ids])
(db/exec-one! conn [sql:restore-file-thumbnails file-ids])
(db/exec-one! conn [sql:restore-file-tagged-object-thumbnails file-ids])))
(db/exec-one! conn [sql:restore-file-tagged-object-thumbnails file-ids])
;; NOTE: the storage objects referenced by the rows we just brought back
;; must stop being marked for deletion. The storage GC cannot delete an
;; object that a live row references (those foreign keys are `NO ACTION`),
;; so a marked object that comes back to life is skipped forever otherwise.
(db/exec-one! conn [sql:restore-storage-objects file-ids])))
(def ^:private sql:restore-projects
"UPDATE project SET deleted_at = null WHERE id = ANY(?::uuid[])")

376
backend/src/app/rpc/commands/jobs.clj Normal file
View File

@ -0,0 +1,376 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.rpc.commands.jobs
"Creation of durable, user-facing jobs.
One command per job type: the body carries the business params its
job-def declares and nothing else, and the job-def schema is the single
place that says what those params are. Creating a job never runs it: it
freezes what the job will do, and the work belongs to the runner."
(:require
[app.binfile.common :as bfc]
[app.binfile.v3 :as bf.v3]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.schema :as sm]
[app.common.time :as ct]
[app.config :as cf]
[app.db :as db]
[app.jobs :as jobs]
[app.jobs.storage :as js]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.rpc.climit :as-alias climit]
[app.rpc.commands.files :as files]
[app.rpc.commands.media :as media]
[app.rpc.commands.projects :as projects]
[app.rpc.doc :as-alias doc]
[app.rpc.quotes :as quotes]
[app.storage :as sto]
[app.tasks.export-binfile :as export-binfile]
[app.tasks.import-binfile :as import-binfile]
[app.util.services :as sv]
[datoteka.fs :as fs]))
(def ^:private schema:create-export-binfile-job
"The `.penpot` package of the files frozen in the params, produced by
the backend runner; the business params are what the `:export-binfile`
job-def declares."
[:map {:title "create-export-binfile-job" :closed true}
[:params export-binfile/schema:params]])
(def ^:private schema:create-import-binfile-job
"The `.penpot` package the caller uploaded, imported into a project by
the backend runner; the business params are what the `:import-binfile`
job-def declares for creation."
[:map {:title "create-import-binfile-job" :closed true}
[:params import-binfile/schema:create-params]
;; the package arrives as a chunked upload and never as a path the
;; caller names: see `assemble-upload`
[:upload-id ::sm/uuid]])
(def ^:private schema:job-summary
"What the caller gets when a job is created: enough to follow it, and
nothing about the work it will do."
[:map {:title "job-summary"}
[:id ::sm/uuid]
[:status ::sm/text]
[:name ::sm/text]
[:created-at ::ct/inst]
[:expires-at [:maybe ::ct/inst]]])
(defn- resolve-job-def
"The job the caller named, refused when it is not a job of `family`: the
registry is the source of truth, and a name that is not one of its jobs
is rejected before anything is read or stored.
The job-def is returned because the caller needs it right away: it is
what decodes and validates the business params."
[cfg family name]
(let [job-def (get (jobs/get-defs cfg) (keyword name))]
(when-not (= family (::jobs/family job-def))
(ex/raise :type :validation
:code :not-a-job-of-the-family
:hint "the job name is not a registered job of that family"
:name (d/name name)
:family (d/name family)))
job-def))
(defn- get-job-summary
[cfg job-id]
(let [job (jobs/get-job cfg job-id)]
{:id (:id job)
:status (jobs/get-user-status (:status job))
:name (:name job)
:created-at (:created-at job)
:expires-at (:expires-at job)}))
(defn- submit-job
"Create the job row with what every user job shares: the queue its
job-def routes the heavy work to (`::jobs/queue-name`, `:binfile` when
the def says nothing), no automatic retry and the expiry of the ledger."
[cfg job-def name params profile-id & {:keys [resource-id]}]
(jobs/submit cfg (cond-> {::jobs/name name
::jobs/params params
::jobs/queue (or (::jobs/queue-name job-def)
:binfile)
::jobs/profile-id profile-id
::jobs/max-retries 0
::jobs/expires-at (ct/plus (ct/now)
(cf/get-jobs-user-ttl))}
(some? resource-id)
(assoc ::jobs/resource-id resource-id))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EXPORT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- single-team-id
"The team id when every `file-ids` entry resolves and they share one
team. Otherwise nil."
[cfg file-ids]
(when (seq file-ids)
(db/run! cfg
(fn [{:keys [::db/conn]}]
(let [arr (db/create-array conn "uuid" file-ids)
rows (db/exec! conn
["SELECT f.id AS file_id, t.id AS team_id
FROM file AS f
JOIN project AS p ON (p.id = f.project_id)
JOIN team AS t ON (t.id = p.team_id)
WHERE f.id = ANY(?)" arr])
teams (into #{} (map :team-id) rows)]
(when (and (= (count file-ids) (count rows))
(= 1 (count teams)))
(first teams)))))))
(sv/defmethod ::create-export-binfile-job
"Create a durable job that exports a set of files as a `.penpot`
package.
Its params are `:file-ids`, the set of files to export, and
`:export-type`, how the libraries of those files are handled: what
the job-def declares, and nothing more. There is no default for the
type, because a caller that does not say it would get a package that
is not the one it asked for.
The job is created, not run: the caller follows it by its id. The
read permission of every file is checked here so a refusal arrives
synchronously, and the handler checks it again before reading."
{::doc/added "2.20"
::webhooks/event? true
::sm/params schema:create-export-binfile-job
::sm/result schema:job-summary}
[cfg {:keys [::rpc/profile-id] :as envelope}]
(let [job-def (resolve-job-def cfg :export :export-binfile)
;; the RPC layer decoded the params against the job-def schema
;; before the command ran
params (jobs/validate-params job-def (:params envelope))
file-ids (:file-ids params)]
(when (empty? file-ids)
(ex/raise :type :validation
:code :no-files-to-export
:hint "expected at least one file to export"))
(doseq [file-id file-ids]
(files/check-read-permissions! cfg profile-id file-id))
(quotes/check! cfg {::quotes/id ::quotes/export-jobs-per-profile
::quotes/profile-id profile-id})
(let [summary (get-job-summary cfg (submit-job cfg job-def :export-binfile
params profile-id))
team-id (single-team-id cfg file-ids)]
(with-meta summary
{::audit/props (cond-> {:job-id (:id summary)
:files (count file-ids)
:export-type (d/name (:export-type params))}
team-id (assoc :team-id team-id))}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; IMPORT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- assemble-upload
"The package the caller uploaded, assembled into a local file that
belongs to this call.
The command only takes a chunked upload: a plain file upload would mean
reading a path the caller named, and the server must never read a file
it did not write itself."
[cfg profile-id upload-id]
(db/tx-run! cfg media/assemble-chunks profile-id upload-id))
(defn- resolve-version
"The version of the package: what the caller says, or what the header
of the file says."
[path version]
(or version
(case (bfc/parse-file-format path)
:binfile-v3 3
1)))
(sv/defmethod ::create-import-binfile-job
"Create a durable job that imports a `.penpot` package into a project.
The package arrives as a chunked upload, which the server assembles
itself: the command never reads a path the caller names. The package is
then checked and stored as the resource of the job, so any worker can
consume it by `resource_id`. The job is created, not run, and the caller
follows it by its id."
{::doc/added "2.20"
::webhooks/event? true
::sm/params schema:create-import-binfile-job
::sm/result schema:job-summary
;; assembling the upload and storing the package happens here, in the
;; request: the same limit the legacy import command declares
::climit/id [[:create-import-binfile-job/by-profile ::rpc/profile-id]
[:create-import-binfile-job/global]]}
[cfg {:keys [::rpc/profile-id] :as envelope}]
(let [job-def (resolve-job-def cfg :import :import-binfile)
;; the RPC layer decoded the params against the create schema
;; before the command ran
given (:params envelope)
project-id (:project-id given)]
;; the edition permission is checked here so a refusal arrives
;; synchronously and before the upload is assembled; the handler
;; checks it again before writing
(projects/check-edition-permissions! cfg profile-id project-id)
(quotes/check! cfg {::quotes/id ::quotes/import-jobs-per-profile
::quotes/profile-id profile-id})
;; the shape of what the caller sent is checked before the upload
;; is assembled: the version is known good here (the create schema
;; rejects one out of range, and the caller may omit it), so the
;; merged map below only adds what the package says
(jobs/validate-params job-def (assoc given :version (or (:version given) 1)))
(let [file (assemble-upload cfg profile-id (:upload-id envelope))
path (:path file)]
;; everything that happens once the upload is on disk belongs to
;; this try: a failure anywhere in it must not leave the temporary
;; file behind
;;
;; the version and the manifest metadata are resolved here, in the
;; command, and not in the job: only the creation path reads the
;; package, and the job keeps what the audit will show
(try
(let [version (resolve-version path (:version given))
manifest (when (= 3 version)
(bf.v3/get-manifest cfg path))
;; the manifest may name the tool that produced the package
;; with either spelling: resolve it once, for the params and
;; for the audit
referer (or (:referer manifest) (:refer manifest))
params (cond-> (assoc given :version version)
manifest
(assoc :generated-by (:generated-by manifest)
:referer referer))]
;; the params are complete here: the version came from the
;; caller or from the package, and the manifest filled the audit
(jobs/validate-params job-def params)
(let [staged (js/put-resource cfg profile-id
{:content (sto/content path)
:filename "package.penpot"
:mtype "application/zip"})]
(try
(let [summary (get-job-summary cfg (submit-job cfg job-def :import-binfile params profile-id
:resource-id (:resource-id staged)))]
(with-meta summary
{::audit/props {:job-id (:id summary)
:generated-by (:generated-by manifest)
:referer referer}}))
(catch Throwable cause
;; the job never came to own the package, so it must not be
;; left for the storage GC to find late
(js/release-resource cfg (:resource-id staged))
(throw cause)))))
(finally
;; the assembled file belongs to this call: the package is
;; already in storage by the time we get here, or the creation
;; failed and it is of no use to anyone
(fs/delete path))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; READ
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private schema:get-job
[:map {:title "get-job" :closed true}
[:id ::sm/uuid]])
(def ^:private schema:job-detail
"The summary of a job plus what only exists once it is over: the result
it produced or, when it failed, its public error."
[:map {:title "job-detail"}
[:id ::sm/uuid]
[:status ::sm/text]
[:name ::sm/text]
[:created-at ::ct/inst]
[:expires-at [:maybe ::ct/inst]]
[:result {:optional true} :any]
[:error {:optional true} :any]])
(defn- get-job-detail
"The job the caller owns, as the answer of `get-job`. A job that does
not exist and a job of another profile get the same answer: the caller
cannot tell them apart."
[cfg profile-id job-id]
(let [job (jobs/get-job cfg job-id)]
(when-not (and (some? job) (= profile-id (:profile-id job)))
(ex/raise :type :not-found
:code :job-not-found
:hint "the job does not exist or belongs to another profile"
:job-id job-id))
(cond-> {:id (:id job)
:status (jobs/get-user-status (:status job))
:name (:name job)
:created-at (:created-at job)
:expires-at (:expires-at job)}
(some? (:result job))
(assoc :result (:result job))
(some? (:error job))
(assoc :error (jobs/decode-job-error (:error job))))))
(sv/defmethod ::get-job
"Read a job the caller created: its state and, once it is over, what it
produced or why it failed.
The result of a finished job is the plain JSON the row holds, because a
result has no schema of its own like the params do: a uuid comes back as
the text it is on disk. The progress and the history of the job are not
part of the answer: a client that follows a job takes its progress from
the websocket, and the event log still has no read surface."
{::doc/added "2.20"
::sm/params schema:get-job
::sm/result schema:job-detail}
[cfg {:keys [::rpc/profile-id] :as params}]
(get-job-detail cfg profile-id (:id params)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CANCEL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private schema:cancel-job
[:map {:title "cancel-job" :closed true}
[:id ::sm/uuid]])
(sv/defmethod ::cancel-job
"Cancel a job the caller created, whether it is still waiting or
already running.
A running job stops at its next beat and rolls its work back; a job
that already finished between the request and the update is answered
with the state it is in, never an error. Like every other command
here, a job of another profile is indistinguishable from one that does
not exist."
{::doc/added "2.20"
::sm/params schema:cancel-job
::sm/result schema:job-summary}
[cfg {:keys [::rpc/profile-id] :as params}]
(let [job-id (:id params)
job (jobs/get-job cfg job-id)]
(when-not (and (some? job) (= profile-id (:profile-id job)))
(ex/raise :type :not-found
:code :job-not-found
:hint "the job does not exist or belongs to another profile"
:job-id job-id))
(jobs/cancel cfg job-id)
;; the answer names the outcome of this call, not the collapsed
;; user status: a job the caller just cancelled reads "cancelled"
(assoc (get-job-summary cfg job-id)
:status (:status (jobs/get-job cfg job-id)))))

12
backend/src/app/rpc/commands/projects.clj
View File

@ -41,8 +41,13 @@
ppr.is_admin,
ppr.can_edit
from project_profile_rel as ppr
inner join project as p on (p.id = ppr.project_id)
where ppr.project_id = ?
and ppr.profile_id = ?")
and ppr.profile_id = ?
and exists (select 1
from team_profile_rel as tpr
where tpr.team_id = p.team_id
and tpr.profile_id = ppr.profile_id)")
(defn- get-permissions
[conn profile-id project-id]
@ -145,7 +150,12 @@
inner join team as t on (t.id = p2.team_id)
where p2.id in (select project_id
from project_profile_rel as ppr
inner join project as p on (p.id = ppr.project_id)
where ppr.profile_id = ?
and exists (select 1
from team_profile_rel as tpr
where tpr.team_id = p.team_id
and tpr.profile_id = ppr.profile_id)
and (ppr.can_edit = true or
ppr.is_owner = true or
ppr.is_admin = true))

4
backend/src/app/rpc/commands/search.clj
View File

@ -32,6 +32,10 @@
where ppr.profile_id = ?
and p.team_id = ?
and (p.deleted_at is null)
and exists (select 1
from team_profile_rel as tpr
where tpr.team_id = p.team_id
and tpr.profile_id = ppr.profile_id)
and (ppr.is_admin = true or
ppr.is_owner = true or
ppr.can_edit = true)

59
backend/src/app/rpc/commands/teams.clj
View File

@ -29,6 +29,7 @@
[app.rpc :as-alias rpc]
[app.rpc.commands.profile :as profile]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.permissions :as perms]
[app.rpc.quotes :as quotes]
[app.setup :as-alias setup]
@ -735,6 +736,37 @@
;; --- Mutation: Leave Team
;; Remove every team-scoped relation of a profile that leaves (or is
;; removed from) a team. File and project roles hang from the team
;; membership: keeping them would let the former member keep reading
;; and editing files through `sql:file-permissions`. Pins are personal
;; state of the same team, so they go too. Other teams are untouched,
;; and rejoining grants fresh roles. Runs inside the caller's
;; transaction.
(def ^:private sql:delete-team-file-rels
"DELETE FROM file_profile_rel AS fpr
USING file AS f
INNER JOIN project AS p ON (p.id = f.project_id)
WHERE fpr.file_id = f.id
AND p.team_id = ?
AND fpr.profile_id = ?")
(def ^:private sql:delete-team-project-rels
"DELETE FROM project_profile_rel AS ppr
USING project AS p
WHERE ppr.project_id = p.id
AND p.team_id = ?
AND ppr.profile_id = ?")
(defn- delete-team-rels
[conn profile-id team-id]
(db/exec! conn [sql:delete-team-file-rels team-id profile-id])
(db/exec! conn [sql:delete-team-project-rels team-id profile-id])
(db/delete! conn :team-project-profile-rel {:profile-id profile-id
:team-id team-id})
(db/delete! conn :team-profile-rel {:profile-id profile-id
:team-id team-id}))
(defn leave-team
[{:keys [::db/conn ::mbus/msgbus]} {:keys [profile-id id reassign-to]}]
(let [perms (get-permissions conn profile-id id)
@ -785,9 +817,7 @@
:code :owner-cant-leave-team
:hint "releasing owner before leave"))
(db/delete! conn :team-profile-rel
{:profile-id profile-id
:team-id id})
(delete-team-rels conn profile-id id)
nil))
@ -838,11 +868,13 @@
:code :non-deletable-team
:hint "impossible to delete default team"))
(let [delay (ldel/get-deletion-delay team)
team (db/update! conn :team
{:deleted-at (ct/in-future delay)}
{:id team-id}
{::db/return-keys true})]
(let [delay (ldel/get-deletion-delay team)
organization-id (dm/get-in team [:organization :id])
team-name (:name team)
team (db/update! conn :team
{:deleted-at (ct/in-future delay)}
{:id team-id}
{::db/return-keys true})]
;; Api call to nitrate
(when (contains? cf/flags :admin-console)
@ -853,7 +885,10 @@
::jobs/params {:object :team
:deleted-at (:deleted-at team)
:id team-id}})
team)))
(rph/with-meta (rph/wrap)
{::audit/props {:organization-id organization-id
:team-id team-id
:team-name team-name}}))))
(def ^:private schema:delete-team
[:map {:title "delete-team"}
@ -865,8 +900,7 @@
::sm/params schema:delete-team
::db/transaction true}
[cfg {:keys [::rpc/profile-id id] :as params}]
(delete-team cfg {:team-id id :profile-id profile-id})
nil)
(delete-team cfg {:team-id id :profile-id profile-id}))
;; --- Mutation: Team Update Role
@ -969,8 +1003,7 @@
(ex/raise :type :validation
:code :cant-remove-owner))
(db/delete! conn :team-profile-rel {:profile-id member-id
:team-id team-id})
(delete-team-rels conn member-id team-id)
;; A removed member that owns the organization of this team keeps
;; read-only access to it, so instead of kicking them out we degrade

31
backend/src/app/rpc/management/jobs.clj
View File

@ -16,6 +16,7 @@
which mandates a valid shared-key before dispatching to these methods.
If the route resolver changes, these methods must be updated accordingly."
(:require
[app.common.exceptions :as ex]
[app.common.schema :as sm]
[app.common.time :as ct]
[app.jobs :as jobs]
@ -60,8 +61,8 @@
(def ^:private schema:report-job-progress-params
[:map {:title "report-job-progress-params"}
;; The progress schema is the same one the jobs substrate validates:
;; `current` is mandatory, `total` and `stage` are optional, and no
;; other key is accepted.
;; `:stage` is mandatory (a keyword of the worker vocabulary) and
;; `:counters` is an optional map of `scope -> {:current :total?}`.
[:job-id ::sm/uuid]
[:progress jobs/schema:progress]])
@ -78,13 +79,25 @@
;; A lost race (row already terminal) reports :skip so the worker
;; stops retrying a report that can never land, mirroring claim-job.
;; The forced route propagates database errors: the external worker
;; must be able to retry a report it was not sure about.
(if (pos? (jobs/heartbeat cfg
:job-id job-id
:progress progress
::jobs/force? true))
{:action :run}
{:action :skip}))
;; must be able to retry a report it was not sure about. The interrupt
;; the beat raises when the job is no longer active is caught here for
;; the same reason, and it never reaches the HTTP error mapping: it is
;; an internal signal, not a failure of the request.
(let [result (ex/try! (jobs/heartbeat cfg
:job-id job-id
:progress progress
::jobs/force? true))]
(cond
(ex/exception? result)
(if (= :interrupt (:type (ex-data result)))
{:action :skip}
(throw result))
(pos? result)
{:action :run}
:else
{:action :skip})))
;; ---- RPC METHOD: COMPLETE-JOB

56
backend/src/app/rpc/quotes.clj
View File

@ -7,6 +7,7 @@
(ns app.rpc.quotes
"Penpot resource usage quotes."
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.schema :as sm]
@ -715,6 +716,61 @@
team-id team-id team-id team-id team-id team-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: BINFILES JOBS PER PROFILE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private schema:jobs-per-profile
[:map [::profile-id ::sm/uuid]])
(def ^:private valid-jobs-per-profile-quote?
(sm/lazy-validator schema:jobs-per-profile))
;; Only the jobs that are still on their way count: a terminal job is not
;; pending work anymore, and the jobs GC removes it. The tenant filters
;; like every other query of the substrate: instances share one database
;; and one profile can have work in more than one of them.
(def ^:private
sql:get-jobs-per-profile
"SELECT count(*) AS total
FROM job
WHERE tenant = ?
AND profile_id = ?
AND status IN ('new', 'scheduled', 'running', 'retry')
AND name = ANY(?)")
(defn- names-of-family
"The registered names of a family of jobs. The quote counts what the
registry knows, so a new job of the family is covered without touching
this file."
[cfg family]
(->> (jobs/get-defs cfg)
(vals)
(filter #(= family (::jobs/family %)))
(map #(d/name (::jobs/name %)))
(vec)))
(defn- check-jobs-quote
[cfg family config-key]
(let [{:keys [::db/conn ::profile-id ::target]} cfg]
(assert (valid-jobs-per-profile-quote? cfg) "invalid quote parameters")
(-> cfg
(assoc ::default (cf/get config-key Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-1 target profile-id])
(assoc ::count-sql [sql:get-jobs-per-profile
(cf/get :tenant)
profile-id
(db/create-array conn "text" (names-of-family cfg family))])
(generic-check!))))
(defmethod check-quote ::export-jobs-per-profile
[cfg]
(check-jobs-quote cfg :export :quotes-export-jobs-per-profile))
(defmethod check-quote ::import-jobs-per-profile
[cfg]
(check-jobs-quote cfg :import :quotes-import-jobs-per-profile))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: DEFAULT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

127
backend/src/app/srepl/main.clj
View File

@ -25,6 +25,7 @@
[app.db.sql :as-alias sql]
[app.features.fdata :as fdata]
[app.features.file-snapshots :as fsnap]
[app.health :as health]
[app.http.session :as session]
[app.jobs :as jobs]
[app.loggers.audit :as audit]
@ -96,6 +97,30 @@
profile (profile/get-profile-by-email conn email)]
(#'auth/send-email-verification! cfg profile)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; INSTANCE AVAILABILITY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn set-offline
"Take this instance out of the load balancer.
The `/readyz` endpoint starts answering 503, so the load balancer
removes the instance from rotation. Requests already in flight are
still served; wait for the load balancer to notice and for the traffic
to drop before restarting the process.
A restarted process comes back online on its own."
[]
(health/set-offline))
(defn set-online
"Put this instance back into the load balancer rotation.
Only needed to undo a `set-offline` without a restart; a restarted
process starts online."
[]
(health/set-online))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PROFILES MANAGEMENT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -768,6 +793,15 @@
:id team-id})))
:deleted))
(def ^:private sql:restore-font-file-objects
"UPDATE storage_object
SET deleted_at = null
WHERE deleted_at IS NOT NULL
AND id IN (SELECT unnest(array[woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id])
FROM team_font_variant
WHERE team_id = ?::uuid
AND deleted_at IS NULL)")
(defn- restore-team*
[{:keys [::db/conn] :as cfg} team-id]
(db/update! conn :team
@ -778,6 +812,11 @@
{:deleted-at nil}
{:team-id team-id})
;; Same as in `restore-files`: the font objects of the variants we just
;; brought back must stop being marked for deletion, or the storage GC will
;; skip them forever (those foreign keys are `NO ACTION`).
(db/exec-one! conn [sql:restore-font-file-objects team-id])
(doseq [{:keys [id]} (db/query conn :project
{:team-id team-id}
{::sql/columns [:id]})]
@ -876,45 +915,69 @@
;; CASCADE FIXING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- submit-deleted-cascade
"Replay the deletion cascade of every soft-deleted row of `table`, by
submitting one `:delete-object` job per row.
Reads the rows with a server-side cursor (`db/plan`) instead of materialising
the whole table, and enqueues the job instead of running it inline, so it
can be used against production in bounded batches. The job is idempotent (it
only marks the children with the row's own date), `label` is the row id and
`dedupe` drops not-yet-due duplicates.
Options: `:limit` (max rows read), `:ids` (restrict the run to these row ids)
and `:dry-run?` (count without enqueueing). `table` and `object` are internal
constants, never operator input.
Returns `{:found n :submitted m}`.
Note: the submissions are given the outer `system` (with the pool) on
purpose; handing them the read-only transaction cfg would write on it."
[system {:keys [table object limit ids dry-run?]}]
(let [clauses (cond-> ["deleted_at is not null"]
(seq ids) (conj "id = any(?)"))
sql (str "select id, deleted_at from " table
" where " (str/join " and " clauses)
(when limit (str " limit " (long limit))))]
(db/tx-run! (assoc system ::db/read-only true)
(fn [{:keys [::db/conn]}]
(let [query (cond-> [sql]
(seq ids) (conj (db/create-array conn "uuid" ids)))
found (reduce (fn [total {:keys [id deleted-at]}]
(when-not dry-run?
(jobs/submit system
{::jobs/name :delete-object
::jobs/params {:object object
:deleted-at deleted-at
:id id}
::jobs/label (str id)
::jobs/dedupe true}))
(inc total))
0
(db/plan conn query))]
{:found found
:submitted (if dry-run? 0 found)})))))
(defn process-deleted-profiles-cascade
[]
(->> (db/exec! sys/system ["select id, deleted_at from profile where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(jobs/invoke (-> sys/system
(assoc ::jobs/name :delete-object)
(assoc ::jobs/params {:object :profile
:deleted-at deleted-at
:id id})))))))
"Replay the deletion cascade of every soft-deleted profile."
[& {:as opts}]
(submit-deleted-cascade sys/system (merge {:table "profile" :object :profile} opts)))
(defn process-deleted-teams-cascade
[]
(->> (db/exec! sys/system ["select id, deleted_at from team where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(jobs/invoke (-> sys/system
(assoc ::jobs/name :delete-object)
(assoc ::jobs/params {:object :team
:deleted-at deleted-at
:id id})))))))
"Replay the deletion cascade of every soft-deleted team."
[& {:as opts}]
(submit-deleted-cascade sys/system (merge {:table "team" :object :team} opts)))
(defn process-deleted-projects-cascade
[]
(->> (db/exec! sys/system ["select id, deleted_at from project where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(jobs/invoke (-> sys/system
(assoc ::jobs/name :delete-object)
(assoc ::jobs/params {:object :project
:deleted-at deleted-at
:id id})))))))
"Replay the deletion cascade of every soft-deleted project."
[& {:as opts}]
(submit-deleted-cascade sys/system (merge {:table "project" :object :project} opts)))
(defn process-deleted-files-cascade
[]
(->> (db/exec! sys/system ["select id, deleted_at from file where deleted_at is not null"])
(run! (fn [{:keys [id deleted-at]}]
(jobs/invoke (-> sys/system
(assoc ::jobs/name :delete-object)
(assoc ::jobs/params {:object :file
:deleted-at deleted-at
:id id})))))))
"Replay the deletion cascade of every soft-deleted file."
[& {:as opts}]
(submit-deleted-cascade sys/system (merge {:table "file" :object :file} opts)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SSO

6
backend/src/app/storage.clj
View File

@ -248,11 +248,15 @@
backend' (impl/resolve-backend storage backend)
bucket (:bucket mdata)
;; `job-resource` objects belong to one profile, so they are
;; never shared: a dedup hit would hand the artifact of one
;; profile to the job of another.
dedupable? (and (::deduplicate? params)
(:hash mdata)
(some? bucket)
(not= tempfile-bucket bucket)
(not= upload-session-bucket bucket))
(not= upload-session-bucket bucket)
(not= job-resource-bucket bucket))
hit (when dedupable?
(get-database-object-by-hash pool backend bucket (:hash mdata)))]

83
backend/src/app/storage/gc_deleted.clj
View File

@ -30,7 +30,7 @@
7)
(def ^:private chunk-size
"Number of rows to process per transaction."
"Pending objects deleted in each transaction."
25)
(def ^:private sql:lock-sobjects
@ -95,9 +95,9 @@
(defn- process-chunk
"Attempt to delete a chunk of storage objects from a specific backend.
This function runs inside the caller's transaction (clean-deleted) —
it does NOT open its own transaction. The caller is responsible for
ensuring the rows are locked via FOR UPDATE SKIP LOCKED before calling.
This function runs inside the chunk's own transaction (see
`delete-in-bulk`) — it does NOT open its own transaction. The rows are
locked via FOR UPDATE SKIP LOCKED before deleting.
Returns the number of successfully deleted objects, or 0 if no rows
could be locked."
@ -143,43 +143,70 @@
(count ok-ids))
0))
(defn- delete-in-bulk
[cfg backend-id ids]
;; Each chunk runs in its own transaction, on its own connection: a chunk
;; that fails (for example, an object that a foreign key still references) is
;; logged and skipped, and it cannot poison the cursor that feeds the rest.
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::sto/storage]}]
(process-chunk conn storage backend-id ids)))
(catch Throwable cause
(l/err :hint "unexpected error on bulk deletion, skipping chunk"
:ids ids
:cause cause)
0)))
(defn- group-by-backend
[items]
(d/group-by (comp keyword :backend) :id #{} items))
(def ^:private sql:get-deleted-chunk
(def ^:private sql:get-deleted-sobjects
"SELECT id, backend
FROM storage_object
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
AND status = 'valid'
ORDER BY deleted_at ASC
LIMIT ?
FOR UPDATE
SKIP LOCKED")
ORDER BY deleted_at ASC")
(defn- get-deleted-chunk
[conn size]
(db/exec! conn [sql:get-deleted-chunk (ct/now) size]))
(defn- pending-row
"Takes the columns the GC needs from a `db/plan` row.
A plan row is a view over the open result set, valid only while the reduction
is running, so it cannot be stored for later: this has to happen inside the
reducing function."
[row]
{:id (:id row)
:backend (:backend row)})
(defn- clean-deleted
"Walks the pending objects with `db/plan`, a server-side cursor that streams
the rows instead of materialising them, and deletes them chunk by chunk.
The rows are read in their own read-only transaction and every chunk of
`chunk-size` objects is deleted in its own one (see `delete-in-bulk`), so a
chunk that fails is logged and skipped instead of aborting the whole run, and
the work of the previous chunks is already committed. A physical-deletion
failure inside a chunk defers its rows one day and gives up after
`max-attempts` attempts (see `process-chunk`)."
[cfg]
(loop [total 0]
(let [deleted (db/tx-run! cfg
(fn [{:keys [::db/conn ::sto/storage]}]
(let [chunk (get-deleted-chunk conn chunk-size)]
(when (seq chunk)
(let [by-backend (group-by-backend chunk)]
(reduce-kv (fn [acc backend-id ids]
(+ acc (process-chunk conn storage backend-id ids)))
0
by-backend))))))]
;; Heartbeat per chunk: each chunk commits on its own, so a long
;; sweep neither loses work on late failure nor outruns the lease.
(jobs/heartbeat cfg)
(if deleted
(recur (+ total deleted))
total))))
(let [xform (comp (map pending-row)
(partition-all chunk-size)
(mapcat group-by-backend))
rf (fn
([total] total)
([total [backend-id ids]]
(let [deleted (or (delete-in-bulk cfg backend-id ids) 0)]
;; Beat the job after every chunk: each chunk commits on its
;; own, so a long sweep neither loses work on a late failure
;; nor outruns the orphan lease.
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce xform rf 0
(db/plan conn [sql:get-deleted-sobjects (ct/now)]))))))
(declare execute-storage-gc-deleted)

2
backend/src/app/storage/s3.clj
View File

@ -370,7 +370,7 @@
;; to the filesystem and then read with buffered inputstream; if
;; not, read the contento into memory using bytearrays.
(if (> ^long size (* 1024 1024 2))
(let [path (tmp/tempfile :prefix "penpot.storage.s3." :min-age "6h")
(let [path (tmp/temp-path :prefix "penpot.storage.s3." :min-age "6h")
rxf (AsyncResponseTransformer/toFile ^Path path)]
(->> (.getObject ^S3AsyncClient client
^GetObjectRequest gor

3
backend/src/app/storage/schema.clj
View File

@ -53,7 +53,8 @@
"organization" #{:organization-id}
tempfile-bucket #{}
upload-session-bucket #{}
job-resource-bucket #{}
;; read back only by the profile that owns them
job-resource-bucket #{:profile-id}
"file-data" #{:file-id :id}
"file-data-fragment" #{}
"file-change" #{}})

19
backend/src/app/storage/tmp.clj
View File

@ -94,6 +94,25 @@
(sp/offer! queue [path (some-> min-age ct/duration)])
path))
(defn temp-path
"Reserve a unique temp path WITHOUT creating the file.
Use it when an external writer needs to create the file itself and
fails if it already exists (like the S3 SDK file download, which
opens with CREATE_NEW). The path is still registered for cleanup,
so a crash between reserve and write does not leak."
[& {:keys [suffix prefix dir min-age]
:or {prefix "penpot."
suffix ".tmp"
dir default-tmp-dir}}]
(fs/create-dir dir)
(loop [path (fs/join dir (str prefix (uuid/next) suffix))]
(if (fs/exists? path)
(recur (fs/join dir (str prefix (uuid/next) suffix)))
(do
(sp/offer! queue [path (some-> min-age ct/duration)])
path))))
(defn tempfile-from
"Create a new tempfile from from consuming the stream"
[input & {:as options}]

94
backend/src/app/tasks/export_binfile.clj Normal file
View File

@ -0,0 +1,94 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.tasks.export-binfile
"The `:export-binfile` job: it produces the `.penpot` artifact of the
set of files frozen in its params."
(:require
[app.binfile.jobs :as bfj]
[app.common.schema :as sm]
[app.db :as db]
[app.jobs :as jobs]
[app.jobs.storage :as js]
[app.metrics :as mtx]
[app.rpc.commands.files :as files]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[datoteka.fs :as fs]
[integrant.core :as ig]))
(def schema:params
"Business params of an export: the files to export, frozen when the job
was created, and how their libraries are handled."
[:map {:title "export-binfile-params" :closed true}
[:file-ids [::sm/set ::sm/uuid]]
[:export-type [::sm/one-of #{:include-libraries :merge-libraries
:detach-libraries :link-later}]]])
(def ^:private artifact
"What the user sees of the package an export produces. A single name
describes a set of files, so it does not come from any of them."
{:filename "export.penpot"
:mtype "application/zip"})
(def schema:result
"What the job stores when the export succeeds: where the artifact can be
downloaded from and what it is."
[:map {:title "export-binfile-result" :closed true}
[:resource-uri ::sm/text]
[:filename ::sm/text]
[:mtype ::sm/text]
[:size ::sm/int]])
(def ^:private check-result
(sm/check-fn schema:result
:hint "invalid result of an export job"
:type :validation
:code :invalid-result))
(defn execute-export
"Plain handler, importable and testable without integrant.
The read permission is checked again here, and not only when the job was
created: it can be revoked while the job waits in its queue. The artifact
is stored as the resource of the job, and the completion envelope carries
its descriptor as the business result and its id for the runner to
associate."
[cfg context params]
(let [profile-id (:profile-id context)
file-ids (:file-ids params)]
(doseq [file-id file-ids]
(files/check-read-permissions! cfg profile-id file-id))
(let [output (tmp/tempfile* :suffix ".penpot")]
(try
(bfj/export-files cfg context {:ids file-ids
:export-type (:export-type params)
:output output})
(let [resource (js/put-resource cfg profile-id
(assoc artifact :content (sto/content output)))]
{:result (check-result (dissoc resource :resource-id))
:resource-id (:resource-id resource)})
(finally
(fs/delete output))))))
(defmethod ig/assert-key ::job-def
[_ params]
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
(assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided")
(assert (mtx/metrics? (::mtx/metrics params)) "expected valid metrics"))
(defmethod ig/init-key ::job-def
[_ cfg]
{::jobs/name :export-binfile
::jobs/family :export
::jobs/resource-role :output
::jobs/schema schema:params
::jobs/handler (fn [context params]
(execute-export cfg context params))
::jobs/decoder (sm/decoder schema:params sm/json-transformer)
::jobs/validator (sm/validator schema:params)})

126
backend/src/app/tasks/import_binfile.clj Normal file
View File

@ -0,0 +1,126 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.tasks.import-binfile
"The `:import-binfile` job: it imports the package the job owns as a
resource into the project frozen in its params."
(:require
[app.binfile.jobs :as bfj]
[app.common.exceptions :as ex]
[app.common.schema :as sm]
[app.db :as db]
[app.jobs :as jobs]
[app.jobs.storage :as js]
[app.metrics :as mtx]
[app.rpc.commands.projects :as projects]
[app.rpc.commands.teams :as teams]
[app.storage :as sto]
[datoteka.fs :as fs]
[integrant.core :as ig]))
(def schema:params
"Business params of an import: where the package goes, its name, the
format version and the manifest metadata kept for audit."
[:map {:title "import-binfile-params" :closed true}
[:project-id ::sm/uuid]
[:name [:or [:string {:max 250}]
[:map-of ::sm/uuid [:string {:max 250}]]]]
[:version [:enum 1 3]]
[:generated-by {:optional true} [:maybe ::sm/text]]
[:referer {:optional true} [:maybe ::sm/text]]])
(def schema:create-params
"The business params of an import as the creation command receives
them: where the package goes and its name. The version is optional
because the command reads it from the package header when the caller
does not say it, and the manifest metadata kept for audit is filled by
the command, never sent by the caller."
[:map {:title "import-binfile-create-params" :closed true}
[:project-id ::sm/uuid]
[:name [:or [:string {:max 250}]
[:map-of ::sm/uuid [:string {:max 250}]]]]
[:version {:optional true} [:enum 1 3]]])
(def schema:result
"What the job stores when the import succeeds: the files it created and
how the libraries of the package were resolved."
[:map {:title "import-binfile-result" :closed true}
[:file-ids [:vector ::sm/uuid]]
[:resolution {:optional true} :map]
[:name [:or [:string {:max 250}]
[:map-of ::sm/uuid [:string {:max 250}]]]]
[:version [:enum 1 3]]])
(def ^:private check-result
(sm/check-fn schema:result
:hint "invalid result of an import job"
:type :validation
:code :invalid-result))
(defn execute-import
"Plain handler, importable and testable without integrant.
The edition permission is checked again here, and not only when the job
was created: it can be revoked while the job waits in its queue. The
core runs inside a transaction, so a cancellation detected between units
rolls the whole import back.
The package is the input of the job: it is released and its temporary
copy deleted once the job is terminal, whatever the outcome. A crash is
covered by the storage GC."
[cfg context params]
(let [profile-id (:profile-id context)
project-id (:project-id params)
input (js/load-input cfg context)]
(try
(projects/check-edition-permissions! cfg profile-id project-id)
(let [team (or (teams/get-team cfg
:profile-id profile-id
:project-id project-id)
(ex/raise :type :not-found
:code :project-not-found
:hint "the destination project is not available"
:profile-id profile-id
:project-id project-id))
result (db/tx-run! cfg
(fn [tx-cfg]
;; the core joins this transaction: it
;; is the one that decides whether the
;; whole import is kept or rolled back
(bfj/import-files tx-cfg context
{:profile-id profile-id
:project-id project-id
:team team
:name (:name params)
:input input
:version (:version params)})))]
(check-result (assoc result
:name (:name params)
:version (:version params))))
(finally
(fs/delete input)
(js/release-input cfg context)))))
(defmethod ig/assert-key ::job-def
[_ params]
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
(assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided")
(assert (mtx/metrics? (::mtx/metrics params)) "expected valid metrics"))
(defmethod ig/init-key ::job-def
[_ cfg]
{::jobs/name :import-binfile
::jobs/family :import
::jobs/resource-role :input
::jobs/schema schema:params
::jobs/handler (fn [context params]
(execute-import cfg context params))
::jobs/decoder (sm/decoder schema:params sm/json-transformer)
::jobs/validator (sm/validator schema:params)})

829
backend/src/app/tasks/objects_gc.clj
View File

@ -18,6 +18,21 @@
[app.tasks.delete-object :as dobj]
[integrant.core :as ig]))
;; Each proc below streams its pending keys with `db/plan`, a server-side
;; cursor, inside a read-only transaction of its own, and deletes them chunk
;; by chunk, each chunk in a transaction of its own, unrelated to the plan
;; one. A chunk that fails is rolled back on its own, reported with `l/err`
;; and skipped, so it takes down its own work and nothing else: the run keeps
;; going and the next run retries the skipped rows.
;;
;; A plan row is a view over the open result set, valid only while the
;; reduction is running, so the key is read inside the reducing function:
;; buffering the row itself yields nil columns.
;;
;; Every proc beats its job (`jobs/heartbeat`) after each processed chunk,
;; through the pool and never through the chunk transaction, so a long backlog
;; in a single proc cannot outrun the orphan lease.
(def ^:private sql:get-upload-sessions
"SELECT us.id
FROM upload_session AS us
@ -30,8 +45,21 @@
WHERE p.id = us.profile_id
AND p.deleted_at IS NOT NULL
AND p.deleted_at <= ?)
ORDER BY us.created_at ASC
LIMIT ?
ORDER BY us.created_at ASC")
(def ^:private sql:lock-upload-sessions
"SELECT us.id
FROM upload_session AS us
WHERE us.id = ANY(?::uuid[])
AND ((us.deleted_at IS NOT NULL
AND us.deleted_at <= ?)
OR (us.deleted_at IS NULL
AND us.created_at <= ?)
OR EXISTS (SELECT 1
FROM profile AS p
WHERE p.id = us.profile_id
AND p.deleted_at IS NOT NULL
AND p.deleted_at <= ?))
FOR UPDATE OF us
SKIP LOCKED")
@ -40,338 +68,628 @@
WHERE session_id = ?
RETURNING object_id")
(defn- delete-upload-sessions!
"Purges consumed upload sessions (marked by assemble-chunks), stalled
sessions (never assembled within max-age) and sessions owned by profiles
pending purge. Referenced storage objects are touched so the storage GC
reclaims them with its usual delay; chunk mappings are removed before the
session row (NO ACTION foreign keys)."
[{:keys [::db/conn ::threshold ::chunk-size ::sto/storage] :as cfg}]
(let [stalled-threshold (ct/minus threshold {:hours 1})]
(->> (db/plan conn [sql:get-upload-sessions threshold stalled-threshold threshold chunk-size]
{:fetch-size 5})
(reduce (fn [total {:keys [id]}]
(l/trc :obj "upload-session" :id (str id))
(defn- delete-upload-sessions-chunk
"Purges one chunk of consumed upload sessions (marked by assemble-chunks),
stalled sessions (never assembled within max-age) and sessions owned by
profiles pending purge. Referenced storage objects are touched so the
storage GC reclaims them with its usual delay; chunk mappings are removed
before the session row (NO ACTION foreign keys)."
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold ::sto/storage]}]
(let [stalled-threshold (ct/minus threshold {:hours 1})
ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-upload-sessions ids threshold stalled-threshold threshold])
(reduce (fn [total {:keys [id]}]
(l/trc :obj "upload-session" :id (str id))
;; Remove the chunk mappings, marking as touched all
;; related storage objects in a single round-trip.
(doseq [{:keys [object-id]} (db/exec! conn [sql:delete-session-chunks id])]
(some->> object-id (sto/touch-object! storage)))
;; Remove the chunk mappings, marking as touched all
;; related storage objects in a single round-trip.
(doseq [{:keys [object-id]} (db/exec! conn [sql:delete-session-chunks id])]
(some->> object-id (sto/touch-object! storage)))
(let [affected (-> (db/delete! conn :upload-session {:id id})
(db/get-update-count))]
(+ total affected)))
0))))
(let [affected (-> (db/delete! conn :upload-session {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "upload-session"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-upload-sessions
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [stalled-threshold (ct/minus threshold {:hours 1})
rf (fn ([total] total)
([total chunk]
(let [deleted (delete-upload-sessions-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-upload-sessions threshold stalled-threshold threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-profiles
"SELECT id, photo_id FROM profile
"SELECT id FROM profile
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-profiles
"SELECT id, photo_id, deleted_at FROM profile
WHERE id = ANY(?::uuid[])
AND deleted_at IS NOT NULL
AND deleted_at <= ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-profiles!
[{:keys [::db/conn ::timestamp ::threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-profiles threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id photo-id]}]
(l/trc :obj "profile" :id (str id))
(defn- delete-profiles-chunk
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold ::sto/storage] :as cfg}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-profiles ids threshold])
(reduce (fn [total {:keys [id photo-id deleted-at]}]
(l/trc :obj "profile" :id (str id))
;; Mark as deleted the storage object
(some->> photo-id (sto/touch-object! storage))
;; Mark as deleted the storage object
(some->> photo-id (sto/touch-object! storage))
;; Cascade soft-delete to owned teams, projects, files, etc.
(dobj/delete-object cfg {:object :profile
:id id
:deleted-at timestamp})
;; Cascade soft-delete to owned teams, projects, files, etc.
;; with the deletion date of the profile, not the
;; date of the run.
(dobj/delete-object cfg {:object :profile
:id id
:deleted-at deleted-at})
(let [affected (-> (db/delete! conn :profile {:id id})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :profile {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "profile"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-profiles
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-profiles-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-profiles threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-teams
"SELECT deleted_at, id, photo_id FROM team
"SELECT id FROM team
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-teams
"SELECT deleted_at, id, photo_id FROM team
WHERE id = ANY(?::uuid[])
AND deleted_at IS NOT NULL
AND deleted_at <= ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-teams!
[{:keys [::db/conn ::threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-teams threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id photo-id deleted-at]}]
(l/trc :obj "team"
:id (str id)
:deleted-at (ct/format-inst deleted-at))
(defn- delete-teams-chunk
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold ::sto/storage]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-teams ids threshold])
(reduce (fn [total {:keys [id photo-id deleted-at]}]
(l/trc :obj "team"
:id (str id)
:deleted-at (ct/format-inst deleted-at))
;; Mark as deleted the storage object
(some->> photo-id (sto/touch-object! storage))
;; Mark as deleted the storage object
(some->> photo-id (sto/touch-object! storage))
;; And finally, permanently delete the team.
(let [affected (-> (db/delete! conn :team {:id id})
(db/get-update-count))]
(+ total affected)))
0)))
;; And finally, permanently delete the team.
(let [affected (-> (db/delete! conn :team {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "team"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-teams
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-teams-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-teams threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-fonts
"SELECT id FROM team_font_variant
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-fonts
"SELECT id, team_id, deleted_at, woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id
FROM team_font_variant
WHERE deleted_at IS NOT NULL
WHERE id = ANY(?::uuid[])
AND deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-fonts!
[{:keys [::db/conn ::threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-fonts threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id team-id deleted-at] :as font}]
(l/trc :obj "font-variant"
:id (str id)
:team-id (str team-id)
:deleted-at (ct/format-inst deleted-at))
(defn- delete-fonts-chunk
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold ::sto/storage]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-fonts ids threshold])
(reduce (fn [total {:keys [id team-id deleted-at] :as font}]
(l/trc :obj "font-variant"
:id (str id)
:team-id (str team-id)
:deleted-at (ct/format-inst deleted-at))
;; Mark as deleted the all related storage objects
(some->> (:woff1-file-id font) (sto/touch-object! storage))
(some->> (:woff2-file-id font) (sto/touch-object! storage))
(some->> (:otf-file-id font) (sto/touch-object! storage))
(some->> (:ttf-file-id font) (sto/touch-object! storage))
;; Mark as deleted the all related storage objects
(some->> (:woff1-file-id font) (sto/touch-object! storage))
(some->> (:woff2-file-id font) (sto/touch-object! storage))
(some->> (:otf-file-id font) (sto/touch-object! storage))
(some->> (:ttf-file-id font) (sto/touch-object! storage))
(let [affected (-> (db/delete! conn :team-font-variant {:id id})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :team-font-variant {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "font-variant"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-fonts
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-fonts-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-fonts threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-projects
"SELECT id, deleted_at, team_id
FROM project
"SELECT id FROM project
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-projects
"SELECT id, deleted_at, team_id FROM project
WHERE id = ANY(?::uuid[])
AND deleted_at IS NOT NULL
AND deleted_at <= ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-projects!
[{:keys [::db/conn ::threshold ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-projects threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id team-id deleted-at]}]
(l/trc :obj "project"
:id (str id)
:team-id (str team-id)
:deleted-at (ct/format-inst deleted-at))
(defn- delete-projects-chunk
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-projects ids threshold])
(reduce (fn [total {:keys [id team-id deleted-at]}]
(l/trc :obj "project"
:id (str id)
:team-id (str team-id)
:deleted-at (ct/format-inst deleted-at))
(let [affected (-> (db/delete! conn :project {:id id})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :project {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "project"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-projects
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-projects-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-projects threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-files
"SELECT f.id,
f.deleted_at,
f.project_id
FROM file AS f
WHERE f.deleted_at IS NOT NULL
AND f.deleted_at <= ?
ORDER BY f.deleted_at ASC
LIMIT ?
"SELECT id FROM file
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-files
"SELECT id, deleted_at, project_id FROM file
WHERE id = ANY(?::uuid[])
AND deleted_at IS NOT NULL
AND deleted_at <= ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-files!
[{:keys [::db/conn ::threshold ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-files threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id deleted-at project-id] :as file}]
(l/trc :obj "file"
:id (str id)
:project-id (str project-id)
:deleted-at (ct/format-inst deleted-at))
(defn- delete-files-chunk
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-files ids threshold])
(reduce (fn [total {:keys [id deleted-at project-id]}]
(l/trc :obj "file"
:id (str id)
:project-id (str project-id)
:deleted-at (ct/format-inst deleted-at))
(let [affected (-> (db/delete! conn :file {:id id})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :file {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "file"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-files
"Deletes the pending files chunk by chunk.
A file that cannot be deleted (for example, because a child row was left
unmarked and its `NO ACTION` foreign key still points at it) aborts the
transaction of the whole chunk: the chunk is reported and skipped, and the
next run retries its files."
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-files-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-files threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-file-thumbnails
"SELECT file_id, revn FROM file_thumbnail
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-file-thumbnails
"SELECT file_id, revn, media_id, deleted_at
FROM file_thumbnail
WHERE deleted_at IS NOT NULL
WHERE (file_id, revn) IN (SELECT file_id, revn FROM unnest(?::uuid[], ?::bigint[]) AS u(file_id, revn))
AND deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
FOR UPDATE
SKIP LOCKED")
(defn delete-file-thumbnails!
[{:keys [::db/conn ::threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-file-thumbnails threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
(l/trc :obj "file-thumbnail"
:file-id (str file-id)
:revn revn
:deleted-at (ct/format-inst deleted-at))
(defn- delete-file-thumbnails-chunk
[cfg rows]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold ::sto/storage]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [file-ids (db/create-array conn "uuid" (map :file-id rows))
revns (db/create-array conn "int8" (map :revn rows))]
(->> (db/exec! conn [sql:lock-file-thumbnails file-ids revns threshold])
(reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
(l/trc :obj "file-thumbnail"
:file-id (str file-id)
:revn revn
:deleted-at (ct/format-inst deleted-at))
;; Mark as deleted the storage object
(some->> media-id (sto/touch-object! storage))
;; Mark as deleted the storage object
(some->> media-id (sto/touch-object! storage))
(let [affected (-> (db/delete! conn :file-thumbnail {:file-id file-id :revn revn})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :file-thumbnail {:file-id file-id :revn revn})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "file-thumbnail"
:hint "error on chunk deletion, skipping it"
:chunk rows
:cause cause)
0)))
(defn- delete-file-thumbnails
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-file-thumbnails-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map (fn [row] {:file-id (:file-id row) :revn (:revn row)}))
(partition-all chunk-size))
rf 0
(db/plan conn [sql:get-file-thumbnails threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-file-object-thumbnails
"SELECT file_id, object_id FROM file_tagged_object_thumbnail
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-file-object-thumbnails
"SELECT file_id, object_id, media_id, deleted_at
FROM file_tagged_object_thumbnail
WHERE deleted_at IS NOT NULL
WHERE (file_id, object_id) IN (SELECT file_id, object_id FROM unnest(?::uuid[], ?::text[]) AS u(file_id, object_id))
AND deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
FOR UPDATE
SKIP LOCKED")
(defn delete-file-object-thumbnails!
[{:keys [::db/conn ::threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-file-object-thumbnails threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [file-id object-id media-id deleted-at]}]
(l/trc :obj "file-object-thumbnail"
:file-id (str file-id)
:object-id object-id
:deleted-at (ct/format-inst deleted-at))
(defn- delete-file-object-thumbnails-chunk
[cfg rows]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold ::sto/storage]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [file-ids (db/create-array conn "uuid" (map :file-id rows))
object-ids (db/create-array conn "text" (map :object-id rows))]
(->> (db/exec! conn [sql:lock-file-object-thumbnails file-ids object-ids threshold])
(reduce (fn [total {:keys [file-id object-id media-id deleted-at]}]
(l/trc :obj "file-object-thumbnail"
:file-id (str file-id)
:object-id object-id
:deleted-at (ct/format-inst deleted-at))
;; Mark as deleted the storage object
(some->> media-id (sto/touch-object! storage))
;; Mark as deleted the storage object
(some->> media-id (sto/touch-object! storage))
(let [affected (-> (db/delete! conn :file-tagged-object-thumbnail
{:file-id file-id :object-id object-id})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :file-tagged-object-thumbnail
{:file-id file-id :object-id object-id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "file-object-thumbnail"
:hint "error on chunk deletion, skipping it"
:chunk rows
:cause cause)
0)))
(defn- delete-file-object-thumbnails
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-file-object-thumbnails-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map (fn [row] {:file-id (:file-id row) :object-id (:object-id row)}))
(partition-all chunk-size))
rf 0
(db/plan conn [sql:get-file-object-thumbnails threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-file-media-objects
"SELECT id FROM file_media_object
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-file-media-objects
"SELECT id, file_id, media_id, thumbnail_id, deleted_at
FROM file_media_object
WHERE deleted_at IS NOT NULL
WHERE id = ANY(?::uuid[])
AND deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-file-media-objects!
[{:keys [::db/conn ::threshold ::chunk-size ::sto/storage] :as cfg}]
(->> (db/plan conn [sql:get-file-media-objects threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id file-id deleted-at] :as fmo}]
(l/trc :obj "file-media-object"
:id (str id)
:file-id (str file-id)
:deleted-at (ct/format-inst deleted-at))
(defn- delete-file-media-objects-chunk
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold ::sto/storage]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-file-media-objects ids threshold])
(reduce (fn [total {:keys [id file-id deleted-at] :as fmo}]
(l/trc :obj "file-media-object"
:id (str id)
:file-id (str file-id)
:deleted-at (ct/format-inst deleted-at))
;; Mark as deleted the all related storage objects
(some->> (:media-id fmo) (sto/touch-object! storage))
(some->> (:thumbnail-id fmo) (sto/touch-object! storage))
;; Mark as deleted the all related storage objects
(some->> (:media-id fmo) (sto/touch-object! storage))
(some->> (:thumbnail-id fmo) (sto/touch-object! storage))
(let [affected (-> (db/delete! conn :file-media-object {:id id})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :file-media-object {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "file-media-object"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-file-media-objects
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-file-media-objects-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-file-media-objects threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-file-data
"SELECT file_id, id FROM file_data
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-file-data
"SELECT file_id, id, type, deleted_at, metadata, backend
FROM file_data
WHERE deleted_at IS NOT NULL
WHERE (file_id, id) IN (SELECT file_id, id FROM unnest(?::uuid[], ?::uuid[]) AS u(file_id, id))
AND deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-file-data!
[{:keys [::db/conn ::threshold ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-file-data threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [file-id id type deleted-at metadata backend]}]
(defn- delete-file-data-chunk
[cfg rows]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold] :as cfg}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [file-ids (db/create-array conn "uuid" (map :file-id rows))
ids (db/create-array conn "uuid" (map :id rows))]
(->> (db/exec! conn [sql:lock-file-data file-ids ids threshold])
(reduce (fn [total {:keys [file-id id type deleted-at metadata backend]}]
(some->> metadata
(fdata/decode-metadata)
(fdata/process-metadata cfg))
(some->> metadata
(fdata/decode-metadata)
(fdata/process-metadata cfg))
(l/trc :obj "file-data"
:id (str id)
:file-id (str file-id)
:type type
:backend backend
:deleted-at (ct/format-inst deleted-at))
(l/trc :obj "file-data"
:id (str id)
:file-id (str file-id)
:type type
:backend backend
:deleted-at (ct/format-inst deleted-at))
(let [affected (-> (db/delete! conn :file-data
{:file-id file-id
:id id
:type type})
(db/get-update-count))]
(+ total affected)))
0)))
(let [affected (-> (db/delete! conn :file-data
{:file-id file-id
:id id
:type type})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "file-data"
:hint "error on chunk deletion, skipping it"
:chunk rows
:cause cause)
0)))
(defn- delete-file-data
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-file-data-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map (fn [row] {:file-id (:file-id row) :id (:id row)}))
(partition-all chunk-size))
rf 0
(db/plan conn [sql:get-file-data threshold]
{:fetch-size 5}))))))
(def ^:private sql:get-file-change
"SELECT id, file_id, deleted_at
FROM file_change
"SELECT id FROM file_change
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
ORDER BY deleted_at ASC
LIMIT ?
ORDER BY deleted_at ASC")
(def ^:private sql:lock-file-change
"SELECT id, file_id, deleted_at FROM file_change
WHERE id = ANY(?::uuid[])
AND deleted_at IS NOT NULL
AND deleted_at <= ?
FOR UPDATE
SKIP LOCKED")
(defn- delete-file-changes!
[{:keys [::db/conn ::threshold ::chunk-size] :as cfg}]
(->> (db/plan conn [sql:get-file-change threshold chunk-size] {:fetch-size 5})
(reduce (fn [total {:keys [id file-id deleted-at] :as xlog}]
(l/trc :obj "file-change"
:id (str id)
:file-id (str file-id)
:deleted-at (ct/format-inst deleted-at))
(defn- delete-file-changes-chunk
[cfg ids]
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::threshold]}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-file-change ids threshold])
(reduce (fn [total {:keys [id file-id deleted-at]}]
(l/trc :obj "file-change"
:id (str id)
:file-id (str file-id)
:deleted-at (ct/format-inst deleted-at))
(let [affected (-> (db/delete! conn :file-change {:id id})
(db/get-update-count))]
(+ total affected)))
0)))
(def ^:private deletion-proc-vars
;; NOTE: upload sessions go first: deleting a profile cascades to its
;; sessions, which would hit the upload_session_chunk NO ACTION foreign key
;; while mappings still exist.
[#'delete-upload-sessions!
#'delete-profiles!
#'delete-file-media-objects!
#'delete-file-object-thumbnails!
#'delete-file-thumbnails!
#'delete-file-data!
#'delete-file-changes!
#'delete-files!
#'delete-projects!
#'delete-fonts!
#'delete-teams!])
(defn- execute-proc
"A generic function that executes the specified proc iterativelly
until 0 results is returned. Heartbeats after each committed chunk so
a long backlog in a single proc cannot outrun the orphan lease
(mirrors storage/gc-deleted clean-deleted, which heartbeats per
chunk)."
[cfg proc-fn]
(loop [total 0]
(let [result (db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(proc-fn cfg)))]
(if (pos? result)
(do
(jobs/heartbeat cfg)
(recur (long (+ total result))))
total))))
(let [affected (-> (db/delete! conn :file-change {:id id})
(db/get-update-count))]
(+ total affected)))
0)))))
(catch Throwable cause
(l/err :obj "file-change"
:hint "error on chunk deletion, skipping it"
:chunk ids
:cause cause)
0)))
(defn- delete-file-changes
[{:keys [::threshold ::chunk-size] :as cfg}]
(let [rf (fn ([total] total)
([total chunk]
(let [deleted (delete-file-changes-chunk cfg chunk)]
(jobs/heartbeat cfg)
(+ total deleted))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce (comp (map :id) (partition-all chunk-size)) rf 0
(db/plan conn [sql:get-file-change threshold]
{:fetch-size 5}))))))
(defmethod ig/assert-key ::job-def
[_ params]
@ -381,6 +699,7 @@
(defmethod ig/expand-key ::job-def
[k v]
{k (assoc v ::chunk-size 100)})
(declare execute-objects-gc)
(def schema:objects-gc-params
@ -406,20 +725,26 @@
"Plain job handler: garbage collect orphan storage objects."
([cfg] (execute-objects-gc cfg {}))
([cfg params]
(let [now (ct/now)
threshold (if (:skip-delay params)
(let [threshold (if (:skip-delay params)
(ct/in-future {:days 3650})
now)
(ct/now))
cfg (assoc cfg
::timestamp now
::threshold threshold
::chunk-size (or (:chunk-size params)
(::chunk-size cfg)))]
(loop [procs (map deref deletion-proc-vars)
total 0]
(if-let [proc-fn (first procs)]
(let [result (execute-proc cfg proc-fn)]
(jobs/heartbeat cfg)
(recur (rest procs)
(long (+ total result))))
{:processed total})))))
(::chunk-size cfg)))
;; NOTE: upload sessions go first: deleting a profile cascades to its
;; sessions, which would hit the upload_session_chunk NO ACTION foreign
;; key while mappings still exist.
total (+ (delete-upload-sessions cfg)
(delete-profiles cfg)
(delete-file-media-objects cfg)
(delete-file-object-thumbnails cfg)
(delete-file-thumbnails cfg)
(delete-file-data cfg)
(delete-file-changes cfg)
(delete-files cfg)
(delete-projects cfg)
(delete-fonts cfg)
(delete-teams cfg))]
{:processed total})))

62
backend/src/app/util/events.clj
View File

@ -5,9 +5,15 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.util.events
"A generic asynchronous events notifications subsystem; used mainly
for mark event points in functions and be able to attach listeners
to them. Mainly used in http.sse for progress reporting."
"Event points of a run: the core marks what it does with `tap`, and
whoever runs it decides where those marks go.
The sink bound for the run decides how each event travels: a function
is called inline, on the same thread, while a channel receives the
event for a listener of its own. The jobs adapter binds a function
that turns taps into heartbeats, so an `:interrupt` it raises aborts
the run right there; the SSE stream binds a channel instead, and its
listener writes what arrives to the response."
(:refer-clojure :exclude [run!])
(:require
[app.common.exceptions :as ex]
@ -15,19 +21,29 @@
[promesa.exec :as px]
[promesa.exec.csp :as sp]))
(def ^:dynamic *channel* nil)
(def ^:dynamic *sink* nil)
(defn tap
([type data]
(when-let [channel *channel*]
(sp/put! channel [type data])
nil))
([channel type data]
(when channel
(sp/put! channel [type data])
nil)))
"Mark an event point of the run in course with `[type data]`.
With no sink bound nothing happens, so untracked runs pay a single
nil check per event point. A function sink is called inline and any
exception it raises propagates to the producer: that is how an
`:interrupt` from a heartbeat stops the run at its next event point.
A channel sink receives the event for its listener instead."
[type data]
(when-let [sink *sink*]
(if (fn? sink)
(sink [type data])
(sp/put! sink [type data]))
nil))
(defn spawn-listener
"Consume the events of `channel` on a thread of its own, until it
closes.
`on-close` runs once the listener stops. A failure of `on-event` is
logged and stops the listener."
[channel on-event on-close]
(assert (sp/chan? channel) "expected active events channel")
@ -39,22 +55,14 @@
(let [result (ex/try! (on-event event))]
(if (ex/exception? result)
(do
(l/wrn :hint "unexpected exception" :cause result)
(l/err :hint "unexpected exception on calling-on-event of spawn-listener"
:cause result)
(sp/close! channel))
(recur)))))
(finally
(on-close)))))
(defn run-with!
"A high-level facility for to run a function in context of event
emiter."
[f on-event]
(binding [*channel* (sp/chan :buf 32)]
(let [listener (spawn-listener *channel* on-event (constantly nil))]
(try
(f)
(finally
(sp/close! *channel*)
(px/await! listener))))))
(try
(on-close)
(catch Exception cause
(l/err :hint "unexpected exception on calling on-close of spawn-listener"
:cause cause)))))))

1
backend/src/app/worker/dispatcher.clj
View File

@ -135,7 +135,6 @@ RETURNING job.id, job.queue, job.name, job.created_at")
(fn []
(doseq [{:keys [id queue name created-at]} rows]
(metrics/record-orphan cfg queue)
(metrics/record-outcome cfg name queue :aborted)
(when (ct/inst? created-at)
(metrics/record-total cfg name queue :aborted
(- (inst-ms timestamp) (inst-ms created-at))))

30
backend/src/app/worker/runner.clj
View File

@ -163,9 +163,22 @@
(throw cause))
(catch Throwable cause
(let [edata (ex-data cause)]
(if (and (< (:retry-num job)
(:max-retries job))
(= ::wrk/retry (:type edata)))
(cond
;; the interrupt is the signal that the job is no longer active:
;; a normal procedure, so it is not reported as an error and it
;; never fails or retries a row that is already terminal
(= :interrupt (:type edata))
(binding [l/*context* (-> (cf/logging-context)
(assoc :params job))]
(l/inf :hint "interrupted"
:tenant tenant
:job-id (str (:job-id edata))
:status (:status edata))
{:status "interrupted"})
(and (< (:retry-num job)
(:max-retries job))
(= ::wrk/retry (:type edata)))
(cond-> {:status "retry" :error cause}
(ct/duration? (:delay edata))
(assoc :delay-ms (inst-ms (:delay edata)))
@ -174,6 +187,8 @@
(= ::wrk/noop (:strategy edata))
(assoc :inc-by 0))
:else
(do
(l/err :hint "unhandled exception on job"
::l/context (assoc (cf/logging-context) :params job)
@ -288,9 +303,12 @@
(process-result [{:keys [status] :as result}]
(ex/try!
(case status
"retry" (handle-job-retry result)
"failed" (handle-job-failure result)
"completed" (handle-job-completion result)
"retry" (handle-job-retry result)
"failed" (handle-job-failure result)
"completed" (handle-job-completion result)
;; the job is no longer active: there is nothing to write,
;; the row is already terminal and whoever stopped it did
"interrupted" nil
(throw (IllegalArgumentException.
(str "invalid status received: '" status "'"))))))

403
backend/test/backend_tests/binfile_jobs_test.clj Normal file
View File

@ -0,0 +1,403 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns backend-tests.binfile-jobs-test
"The binfile work of a job: the shared adapter that runs it with its
progress reported as job events, and the two job-defs that expose it."
(:require
[app.binfile.common :as bfc]
[app.binfile.jobs :as bfj]
[app.binfile.v3 :as v3]
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.jobs :as jobs]
[app.jobs.storage :as js]
[app.rpc.commands.teams :as teams]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[app.util.events :as events]
[backend-tests.helpers :as th]
[clojure.java.io :as jio]
[clojure.test :as t]
[datoteka.fs :as fs]
[datoteka.io :as io]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(def ^:private fixture
"A real penpot export, the same fixture the binfile tests read."
"backend_tests/test_files/svg-attrs-camel-case.penpot")
(defn- fixture-path
[]
(-> fixture io/resource jio/file))
(defn- import-fixture!
"A file in the default project of the profile, imported from the
fixture through the core."
[profile]
(-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input (fixture-path))
(v3/import-files!)))
(defn- make-job!
"A job row as the substrate writes it: running, owned by a profile and
holding a resource when the test needs one."
[profile-id resource-id]
(let [id (uuid/next)]
(th/db-insert! :job {:id id
:name "export-binfile"
:tenant (cf/get :tenant)
:queue "binfile"
:params (db/json {})
:priority 100
:max-retries 0
:retry-num 0
:status "running"
:profile-id profile-id
:resource-id resource-id
:scheduled-at (ct/now)
:created-at (ct/now)
:modified-at (ct/now)})
id))
(defn- job-cfg
"The system cfg as the runner hands it to a handler. The job id is NOT
bound here: the adapter takes it from the context, because the progress
bridge runs on a thread of its own."
[]
th/*system*)
(defn- job-context
[job-id]
(jobs/make-context (jobs/get-job th/*system* job-id)))
(defn- progress-events
"The progress events of a job, oldest first, with decoded payloads."
[job-id]
(->> (th/db-exec! ["SELECT payload FROM job_event
WHERE job_id = ? AND kind = 'progress'
ORDER BY created_at ASC, id ASC"
job-id])
(mapv #(jobs/decode-progress (:payload %)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ADAPTER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest export-through-the-adapter-produces-the-artifact
(let [profile (th/create-profile* 1)
file-id (first (:file-ids (import-fixture! profile)))
job-id (make-job! (:id profile) nil)
output (tmp/tempfile* :suffix ".penpot")]
(bfj/export-files (job-cfg) (job-context job-id)
{:ids #{file-id}
:export-type :detach-libraries
:output output})
(t/testing "the artifact is a penpot file with its manifest"
(t/is (fs/exists? output))
(t/is (= [file-id] (mapv :id (:files (v3/get-manifest th/*system* output))))))
(t/testing "the progress of the core became milestones of the job"
(let [events (progress-events job-id)]
(t/is (pos? (count events)))
(t/is (every? keyword? (map :stage events)))
(t/testing "the first one is the file in course, with its position"
(let [event (first events)]
(t/is (= :files (:stage event)))
(t/is (= {:current 1 :total 1} (get-in event [:counters :files])))))
(t/testing "and nothing else: the event is the stage and the counters"
(t/is (every? #(<= (count (keys %)) 2) events)))))))
(t/deftest import-through-the-adapter-imports-the-package
(let [profile (th/create-profile* 1)
team (teams/get-team th/*system*
:profile-id (:id profile)
:project-id (:default-project-id profile))
staged (js/put-resource th/*system* (:id profile)
{:content (sto/content (fixture-path))
:filename "package.penpot"
:mtype "application/zip"})
job-id (make-job! (:id profile) (:resource-id staged))
context (job-context job-id)
result (bfj/import-files (job-cfg) context
{:profile-id (:id profile)
:project-id (:default-project-id profile)
:team team
:name "imported"
:input (js/load-input th/*system* context)
:version 3})]
(t/testing "the package is imported in the destination project"
(t/is (= 1 (count (:file-ids result)))))
(t/testing "the job reported its progress"
(t/is (pos? (count (progress-events job-id)))))))
(t/deftest the-adapter-composes-a-milestone-per-tap
(let [profile (th/create-profile* 1)
file-id (first (:file-ids (import-fixture! profile)))
job-id (make-job! (:id profile) nil)
reports (atom [])]
;; the substrate throttles the durable events, so the whole stream of
;; milestones is only visible with the writes intercepted
(with-redefs [jobs/heartbeat (fn [_cfg & {:as options}]
(swap! reports conj (:progress options))
1)]
(bfj/export-files (job-cfg) (job-context job-id)
{:ids #{file-id}
:export-type :detach-libraries
:output (tmp/tempfile* :suffix ".penpot")}))
(t/testing "the file opens the run with its position"
(let [event (first @reports)]
(t/is (= :files (:stage event)))
(t/is (= {:current 1 :total 1} (get-in event [:counters :files])))))
(t/testing "the stages inside the file carry it as context, with their own counter"
(let [event (first (filter #(= :pages (:stage %)) @reports))]
(t/is (= {:current 1 :total 1} (get-in event [:counters :files])))
(t/is (pos? (get-in event [:counters :pages :current])))
(t/is (pos? (get-in event [:counters :pages :total])))))
(t/testing "a stage outside a file carries no file context"
(let [events (filter #(= :storage-objects (:stage %)) @reports)]
(t/is (pos? (count events)))
(t/is (every? #(nil? (get-in % [:counters :files])) events))))
(t/testing "and every milestone is a stage and its counters, and nothing else"
(t/is (every? #(<= (count (keys %)) 2) @reports)))))
(t/deftest a-tap-carries-the-outer-counters-in-course
(let [profile (th/create-profile* 1)
file-id (first (:file-ids (import-fixture! profile)))
job-id (make-job! (:id profile) nil)
taps (atom [])]
;; the taps themselves, before the adapter turns them into events
(with-redefs [events/tap (fn [_type data] (swap! taps conj data))]
(bfj/export-files (job-cfg) (job-context job-id)
{:ids #{file-id}
:export-type :detach-libraries
:output (tmp/tempfile* :suffix ".penpot")}))
(t/testing "the tap that opens the file carries the outer counters"
(let [tap (first (filter #(= :file (:section %)) @taps))]
(t/is (= {:files {:current 1 :total 1}} (:outer-counters tap)))))
(t/testing "every tap inside the file carries them as context"
(let [inner (filter #(some? (:file-id %)) @taps)]
(t/is (pos? (count inner)))
(t/is (every? #(= {:files {:current 1 :total 1}} (:outer-counters %)) inner))))
(t/testing "a tap outside a file carries no outer counters"
(let [outside (filter #(= :storage-object (:section %)) @taps)]
(t/is (pos? (count outside)))
(t/is (every? #(nil? (:outer-counters %)) outside))))))
(t/deftest a-milestone-merges-outer-counters-with-its-own
(let [milestone @#'bfj/milestone]
(t/testing "outer scopes survive next to the counter of the stage"
(t/is (= {:stage :pages
:counters {:teams {:current 1 :total 1}
:projects {:current 2 :total 2}
:files {:current 1 :total 4}
:pages {:current 2 :total 5}}}
(milestone {:section :page
:current 2 :total 5
:outer-counters {:teams {:current 1 :total 1}
:projects {:current 2 :total 2}
:files {:current 1 :total 4}}}))))
(t/testing "a file tap needs no own counter, the outer one is enough"
(t/is (= {:stage :files
:counters {:files {:current 1 :total 2}}}
(milestone {:section :file
:outer-counters {:files {:current 1 :total 2}}}))))))
(t/deftest entering-a-file-keeps-the-counters-of-the-outer-scopes
(let [cfg {::v3/outer-counters {:teams {:current 1 :total 1}}}
cfg' (@#'v3/with-outer-counter cfg :files {:current 2 :total 4})]
(t/is (= {:teams {:current 1 :total 1}
:files {:current 2 :total 4}}
(::v3/outer-counters cfg')))))
(t/deftest the-import-adapter-composes-the-same-milestones
(let [profile (th/create-profile* 1)
team (teams/get-team th/*system*
:profile-id (:id profile)
:project-id (:default-project-id profile))
staged (js/put-resource th/*system* (:id profile)
{:content (sto/content (fixture-path))
:filename "package.penpot"
:mtype "application/zip"})
job-id (make-job! (:id profile) (:resource-id staged))
context (job-context job-id)
reports (atom [])]
(with-redefs [jobs/heartbeat (fn [_cfg & {:as options}]
(swap! reports conj (:progress options))
1)]
(bfj/import-files (job-cfg) context
{:profile-id (:id profile)
:project-id (:default-project-id profile)
:team team
:name "imported"
:input (js/load-input th/*system* context)
:version 3}))
(t/testing "the run opens with the manifest, which has no units to count"
(let [event (first @reports)]
(t/is (= :manifest (:stage event)))
(t/is (nil? (:counters event)))))
(t/testing "the file carries its position"
(let [event (first (filter #(= :files (:stage %)) @reports))]
(t/is (= {:current 1 :total 1} (get-in event [:counters :files])))))
(t/testing "a stage inside the file carries it as context, with its own counter"
(let [event (first (filter #(= :pages (:stage %)) @reports))]
(t/is (= {:current 1 :total 1} (get-in event [:counters :files])))
(t/is (pos? (get-in event [:counters :pages :current])))
(t/is (pos? (get-in event [:counters :pages :total])))))
(t/testing "and every milestone is a stage and its counters, and nothing else"
(t/is (every? #(<= (count (keys %)) 2) @reports)))))
(t/deftest a-job-that-is-no-longer-active-stops-the-work
(let [profile (th/create-profile* 1)
file-id (first (:file-ids (import-fixture! profile)))
job-id (make-job! (:id profile) nil)
context (job-context job-id)]
(t/testing "a running job is active"
(t/is (nil? (bfj/check-active th/*system* context))))
(t/testing "a cancelled job is not"
(th/db-update! :job {:status "cancelled"} {:id job-id})
(let [cause (try (bfj/check-active th/*system* context) nil
(catch Throwable raised raised))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (= "cancelled" (:status (ex-data cause))))))
(t/testing "so the export stops at its next progress point"
(let [output (tmp/tempfile* :suffix ".penpot")
cause (try
(bfj/export-files (job-cfg) context
{:ids #{file-id}
:export-type :detach-libraries
:output output})
nil
(catch Throwable raised raised))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (zero? (count (progress-events job-id))))))
(t/testing "a job that already completed is not active either"
(th/db-update! :job {:status "completed"} {:id job-id})
(let [cause (try (bfj/check-active th/*system* context) nil
(catch Throwable raised raised))]
(t/is (= :interrupt (th/ex-type cause)))))
(t/testing "and neither is a job row that is gone"
(th/db-force-delete :job {:id job-id})
(let [cause (try (bfj/check-active th/*system* context) nil
(catch Throwable raised raised))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (= "gone" (:status (ex-data cause))))))))
(t/deftest an-interrupted-beat-stops-the-core-at-its-tap
(let [steps (atom [])
context {:id (uuid/next)}
cause (ex-info "the job is no longer active"
{:type :interrupt :code :job-interrupted})]
(with-redefs [jobs/heartbeat (fn [& _] (throw cause))]
(let [raised (try (@#'bfj/with-progress th/*system* context
(fn []
(swap! steps conj :before)
;; the sink calls the beat
;; inline, so its interrupt
;; aborts the run here
(events/tap :progress {:section :file})
(swap! steps conj :after)))
nil
(catch Throwable stopped stopped))]
(t/is (= :interrupt (:type (ex-data raised))))
(t/is (= :job-interrupted (:code (ex-data raised))))
(t/is (= [:before] @steps)
"the core stopped at its next tap, the step after never ran")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; JOB-DEFS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest the-binfile-jobs-follow-the-substrate-contract
(let [defs (::jobs/defs th/*system*)]
(t/testing "the export job produces the resource of a user job"
(let [def (jobs/get-job-def defs :export-binfile)]
(t/is (= :export (::jobs/family def)))
(t/is (= :output (::jobs/resource-role def)))
(t/is (fn? (::jobs/handler def)))))
(t/testing "the import job consumes the resource of the job"
(let [def (jobs/get-job-def defs :import-binfile)]
(t/is (= :import (::jobs/family def)))
(t/is (= :input (::jobs/resource-role def)))
(t/is (fn? (::jobs/handler def)))))
(t/testing "the params are a closed contract"
(let [def (jobs/get-job-def defs :export-binfile)
file-id (uuid/next)]
(t/is (true? ((::jobs/validator def)
{:file-ids #{file-id} :export-type :detach-libraries})))
(t/testing "a job id never travels in params"
(t/is (false? ((::jobs/validator def)
{:file-ids #{file-id} :export-type :detach-libraries
:job-id (uuid/next)}))))))))
(t/deftest the-export-handler-runs-through-the-registry
(let [profile (th/create-profile* 1)
file-id (first (:file-ids (import-fixture! profile)))
job-id (make-job! (:id profile) nil)
result (jobs/invoke (-> th/*system*
(assoc ::jobs/name :export-binfile)
(assoc ::jobs/params {:file-ids #{file-id}
:export-type :detach-libraries})
(assoc ::jobs/context (job-context job-id))))]
(t/testing "the handler answers with the completion envelope of the job"
(t/is (uuid? (:resource-id result)))
(t/is (some? (get-in result [:result :resource-uri]))))
(t/testing "the handler reported progress without knowing the job id"
(t/is (pos? (count (progress-events job-id)))))))
(t/deftest the-import-handler-runs-through-the-registry
(let [profile (th/create-profile* 1)
staged (js/put-resource th/*system* (:id profile)
{:content (sto/content (fixture-path))
:filename "package.penpot"
:mtype "application/zip"})
job-id (make-job! (:id profile) (:resource-id staged))
result (jobs/invoke (-> th/*system*
(assoc ::jobs/name :import-binfile)
(assoc ::jobs/params {:project-id (:default-project-id profile)
:name "imported"
:version 3})
(assoc ::jobs/context (job-context job-id))))]
(t/testing "the package of the job was imported"
(t/is (pos? (count (:file-ids result)))))
(t/testing "the handler reported progress without knowing the job id"
(t/is (pos? (count (progress-events job-id)))))))

427
backend/test/backend_tests/binfile_svg_test.clj Normal file
View File

@ -0,0 +1,427 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns backend-tests.binfile-svg-test
"SVG sanitization on the binfile import path.
Second case of GHSA-ffhp-m958-qxvr: a crafted `.penpot` bundle can
smuggle an unsanitized SVG storage object past the upload-path
sanitizer, and the raw bytes are served same-origin as
`image/svg+xml`."
(:require
[app.binfile.common :as bfc]
[app.binfile.v1 :as v1]
[app.binfile.v3 :as v3]
[app.common.features :as cfeat]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.storage :as sto]
[app.storage.tmp :as tmp]
[backend-tests.helpers :as th]
[clojure.data.json :as json]
[clojure.java.io :as jio]
[clojure.string :as str]
[clojure.test :as t]
[datoteka.fs :as fs]
[datoteka.io :as io])
(:import
java.io.ByteArrayInputStream
java.util.zip.ZipEntry
java.util.zip.ZipFile
java.util.zip.ZipOutputStream))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(def ^:private evil-svg
"<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"64\" height=\"64\"><script>PWNMARK_SCRIPT</script><circle r=\"20\"/></svg>")
(def ^:private evil-xhref-svg
"<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:x=\"http://www.w3.org/1999/xlink\" width=\"64\" height=\"64\"><a x:href=\"javascript:PWNMARK_XHREF\"><text x=\"10\" y=\"30\">click</text></a></svg>")
(def ^:private clean-svg
"<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"10\" height=\"10\"><circle r=\"4\"/></svg>")
(defn- utf8bytes
[^String s]
(.getBytes s "UTF-8"))
(defn- bytes-str
[^bytes data]
(String. data "UTF-8"))
(t/deftest sanitize-imported-svg-removes-script
(let [result (bfc/sanitize-imported-svg {:content-type "image/svg+xml" :bucket "file-media-object"}
(utf8bytes evil-svg))]
(t/is (some? result))
(t/is (not (str/includes? (bytes-str (:bytes result)) "<script")))
(t/is (not (str/includes? (bytes-str (:bytes result)) "PWNMARK_SCRIPT")))))
(t/deftest sanitize-imported-svg-removes-aliased-xhref
(let [object {:content-type "image/svg+xml; charset=utf-8" :bucket "file-media-object"}
object (update object :content-type bfc/normalize-content-type)
result (bfc/sanitize-imported-svg object (utf8bytes evil-xhref-svg))]
(t/is (some? result))
(t/is (not (str/includes? (bytes-str (:bytes result)) "javascript:")))
(t/is (not (str/includes? (bytes-str (:bytes result)) "PWNMARK_XHREF")))))
(t/deftest svg-object-predicate-expects-canonical
(t/is (true? (bfc/svg-object? {:content-type "image/svg+xml"})))
(t/is (false? (bfc/svg-object? {:content-type "IMAGE/SVG+XML"})))
(t/is (false? (bfc/svg-object? {:content-type nil})))
(t/is (false? (bfc/svg-object? {}))))
(t/deftest sanitize-imported-svg-matches-obfuscated-spelling
(t/testing "spellings normalized at the import boundary still sanitize"
(doseq [ctype ["IMAGE/SVG+XML" "Image/Svg+Xml" " image/svg+xml " "image/svg+xml; charset=utf-8"]]
(let [object {:content-type ctype :bucket "file-media-object"}
object (update object :content-type bfc/normalize-content-type)
result (bfc/sanitize-imported-svg object (utf8bytes evil-svg))]
(t/is (some? result) (str "expected sanitize for " (pr-str ctype)))
(when (some? result)
(t/is (not (str/includes? (bytes-str (:bytes result)) "<script"))
(str "script survived for " (pr-str ctype))))))))
(t/deftest sanitize-imported-svg-ignores-missing-or-blank-type
(t/testing "ancient bundle entries without content-type pass through untouched"
(let [raw (utf8bytes "not-an-svg")]
(t/is (nil? (bfc/sanitize-imported-svg {} raw)))
(t/is (nil? (bfc/sanitize-imported-svg {:content-type nil} raw)))
(t/is (nil? (bfc/sanitize-imported-svg {:content-type ""} raw)))
(t/is (nil? (bfc/sanitize-imported-svg {:content-type " "} raw))))))
(t/deftest sanitize-imported-svg-ignores-non-svg
(t/testing "objects that are not SVG pass through untouched"
(let [raw (utf8bytes "not-an-svg")]
(t/is (nil? (bfc/sanitize-imported-svg {:content-type "image/jpeg" :bucket "file-media-object"} raw)))
(t/is (nil? (bfc/sanitize-imported-svg {:content-type "image/png" :bucket "file-media-object"} raw))))))
(t/deftest sanitize-imported-svg-reports-size-and-hash
(let [result (bfc/sanitize-imported-svg {:content-type "image/svg+xml" :bucket "file-media-object"}
(utf8bytes clean-svg))]
(t/is (some? result))
(t/is (= (alength ^bytes (:bytes result)) (:size result)))
(t/is (str/starts-with? (:hash result) "blake2b:"))
(t/is (str/includes? (bytes-str (:bytes result)) "<circle"))))
(t/deftest sanitize-imported-svg-rejects-broken-svg
(t/testing "unparseable SVG raises the same validation error as the upload path"
(t/is (thrown-with-msg? Exception #"SVG parsing failed during sanitization"
(bfc/sanitize-imported-svg {:content-type "image/svg+xml" :bucket "file-media-object"}
(utf8bytes "<svg><not-closed>"))))))
(t/deftest check-storage-content-type-allows-known-types
(doseq [ctype ["image/svg+xml" "image/jpeg" "font/woff2" "application/octet-stream"]]
(t/is (nil? (bfc/check-storage-content-type {:content-type ctype}))
(str "expected pass for " (pr-str ctype)))))
(t/deftest check-storage-content-type-rejects-unknown-types
(doseq [ctype ["text/html" "application/x-font-woff" nil "" " "]]
(let [object (if (nil? ctype) {} {:content-type ctype})
out (try (bfc/check-storage-content-type object)
nil
(catch clojure.lang.ExceptionInfo e
(ex-data e)))]
(t/is (= :validation (:type out)) (str "expected validation for " (pr-str ctype)))
(t/is (= :media-type-not-allowed (:code out)) (str "expected media-type-not-allowed for " (pr-str ctype))))))
(t/deftest storage-object-schema-constrains-content-type
(t/testing "known stored types validate, unknown types do not"
(let [base {:id (uuid/random) :size 10 :bucket "file-media-object"}]
(doseq [ctype ["image/svg+xml" "image/jpeg" "image/png"
"font/woff2" "font/ttf" "application/octet-stream" "application/pdf"]]
(t/is (some? (v3/validate-storage-object (assoc base :content-type ctype)))
(str "expected valid for " (pr-str ctype))))
(doseq [ctype ["" " " "image /svg" "image/apng" "image/avif"
"application/x-font-woff" (apply str (repeat 200 "x"))]]
(t/is (thrown? clojure.lang.ExceptionInfo
(v3/validate-storage-object (assoc base :content-type ctype)))
(str "expected rejection for " (pr-str ctype)))))))
(defn- write-temp-svg
"Write `text` to a tempfile and return `[path size]`."
[text]
(let [path (fs/create-tempfile :prefix "penpot-svg-import-test-" :suffix ".svg")
data (utf8bytes text)]
(spit (str path) text :encoding "UTF-8")
[path (alength data)]))
(defn- tamper-svg-entry!
"Copy `src` zip to `dst` zip replacing the `objects/<storage-id>.svg`
payload with `evil-bytes` and fixing its `.json` sidecar (size and
blake2b hash) so the bundle passes the integrity checks. When
`content-type` is given, the sidecar declares it instead of the
original spelling."
[src dst storage-id ^bytes evil-bytes & {:keys [content-type]}]
(let [svg-name (str "objects/" storage-id ".svg")
json-name (str "objects/" storage-id ".json")]
(with-open [zin (ZipFile. (.toFile ^java.nio.file.Path src))
zout (ZipOutputStream. (io/output-stream dst))]
(doseq [entry (enumeration-seq (.entries zin))]
(let [name (.getName ^ZipEntry entry)]
(cond
(= name svg-name)
(do (.putNextEntry zout (ZipEntry. ^String name))
(.write zout evil-bytes 0 (alength evil-bytes))
(.closeEntry zout))
(= name json-name)
(let [raw (slurp (.getInputStream zin entry) :encoding "UTF-8")
parsed (json/read-str raw)
updated (cond-> (assoc parsed
"size" (alength evil-bytes)
"hash" (sto/calculate-hash (ByteArrayInputStream. evil-bytes)))
content-type (assoc "contentType" content-type))]
(.putNextEntry zout (ZipEntry. ^String name))
(.write zout (utf8bytes (json/write-str updated)))
(.closeEntry zout))
:else
(do (.putNextEntry zout (ZipEntry. ^String name))
(with-open [in (.getInputStream zin entry)]
(io/copy in zout))
(.closeEntry zout))))))))
(defn- setup-file-with-svg-media
"Upload `clean-svg`, attach it to a shape fill and return
`[file uploaded]` ready to export."
[profile n]
(let [file (th/create-file* n {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
[svg-path svg-size] (write-temp-svg clean-svg)
out (th/command! {::th/type :upload-file-media-object
::rpc/profile-id (:id profile)
:file-id (:id file)
:is-local true
:name "benign.svg"
:content {:filename "benign.svg"
:path svg-path
:mtype "image/svg+xml"
:size svg-size}})
_ (t/is (nil? (:error out)) (str "upload failed: " (pr-str (:error out))))
uploaded (:result out)
page-id (first (get-in file [:data :pages]))
shape-id (uuid/random)
upd (th/command! {::th/type :update-file
::rpc/profile-id (:id profile)
:id (:id file)
:session-id (uuid/random)
:revn 0
:vern 0
:features cfeat/supported-features
:changes
[{:type :add-obj
:page-id page-id
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shape-id
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect
:fills [{:fill-opacity 1
:fill-image {:id (:id uploaded)
:width (:width uploaded)
:height (:height uploaded)
:mtype "image/svg+xml"}}]})}]})]
(t/is (nil? (:error upd)) (str "update-file failed: " (pr-str (:error upd))))
(t/is (uuid? (:media-id uploaded)))
[file uploaded]))
(defn- export-tamper-import-v3
"Export `file` to v3, tamper its SVG payload with `evil-text`
(declaring `content-type` when given) and import the bundle.
Returns `[served-bytes stored-content-type]` of the imported
media."
[profile file media-id evil-text content-type]
(let [bundle (tmp/tempfile :prefix "penpot-export-" :suffix ".zip")]
(v3/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/embed-assets false)
(assoc ::bfc/include-libraries false))
(io/output-stream bundle))
(let [evil (tmp/tempfile :prefix "penpot-evil-" :suffix ".zip")
_ (tamper-svg-entry! bundle evil media-id (utf8bytes evil-text) :content-type content-type)
result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/team-id (:default-team-id profile))
(assoc ::bfc/input evil)
(v3/import-files!))]
(t/is (= 1 (count (:file-ids result))))
(let [rows (th/db-query :file-media-object {:file-id (first (:file-ids result))})
storage (:app.storage/storage th/*system*)]
(t/is (= 1 (count rows)))
(let [object (sto/get-object storage (:media-id (first rows)))]
[(bytes-str (sto/get-object-bytes storage object))
(:content-type (meta object))])))))
(t/deftest import-binfile-v3-sanitizes-smuggled-svg
(let [profile (th/create-profile* 1)
[file uploaded] (setup-file-with-svg-media profile 1)
[served _stored] (export-tamper-import-v3 profile file (:media-id uploaded) evil-svg nil)]
(t/is (not (str/includes? served "<script")))
(t/is (not (str/includes? served "PWNMARK_SCRIPT")))))
(t/deftest import-binfile-v3-sanitizes-obfuscated-content-type
(t/testing "non-canonical content-type spellings still sanitize and store canonical"
(doseq [[n ctype] [[2 "IMAGE/SVG+XML"]
[3 "image/svg+xml; charset=utf-8"]]]
(let [profile (th/create-profile* n)
[file uploaded] (setup-file-with-svg-media profile n)
[served stored] (export-tamper-import-v3 profile file (:media-id uploaded) evil-svg ctype)]
(t/is (not (str/includes? served "<script")) (str "script survived for " (pr-str ctype)))
(t/is (not (str/includes? served "PWNMARK_SCRIPT")) (str "marker survived for " (pr-str ctype)))
(t/is (= "image/svg+xml" stored) (str "stored type not canonical for " (pr-str ctype)))))))
;; ----------------------------------------------------------------
;; v1 import path: exhaustive coverage (F2)
;; ----------------------------------------------------------------
(t/deftest sanitize-imported-svg-from-tempfile-resource
(t/testing "bytes read back from a tempfile (v1 large-object shape) sanitize"
(let [path (fs/create-tempfile :prefix "penpot-svg-resource-" :suffix ".svg")
_ (spit (str path) evil-svg :encoding "UTF-8")
raw (with-open [istream (jio/input-stream path)]
(io/read istream))
result (bfc/sanitize-imported-svg {:content-type "image/svg+xml"} raw)]
(t/is (some? result))
(t/is (not (str/includes? (bytes-str (:bytes result)) "<script")))
(t/is (not (str/includes? (bytes-str (:bytes result)) "PWNMARK_SCRIPT"))))))
(defn- seed-file-with-svg-media
"Seed storage and file_media_object rows directly (bypassing the
upload sanitizer) so exports carry `svg-text` verbatim. Attaches
the media to a shape fill and returns `[file media-id]`. The
storage object declares `content-type`, which may use a
non-canonical spelling to prove the predicate."
[profile n svg-text content-type]
(let [file (th/create-file* n {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
storage (:app.storage/storage th/*system*)
raw (utf8bytes svg-text)
content (-> (sto/content raw)
(sto/wrap-with-hash (sto/calculate-hash (ByteArrayInputStream. raw))))
sobj (sto/put-object! storage {::sto/content content
:content-type content-type
:bucket "file-media-object"})
fmo-id (uuid/random)
_ (th/db-insert! :file-media-object
{:id fmo-id
:file-id (:id file)
:is-local true
:name "seed.svg"
:media-id (:id sobj)
:width 64
:height 64
:mtype content-type})
page-id (first (get-in file [:data :pages]))
shape-id (uuid/random)
upd (th/command! {::th/type :update-file
::rpc/profile-id (:id profile)
:id (:id file)
:session-id (uuid/random)
:revn 0
:vern 0
:features cfeat/supported-features
:changes
[{:type :add-obj
:page-id page-id
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shape-id
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect
:fills [{:fill-opacity 1
:fill-image {:id fmo-id
:width 64
:height 64
:mtype "image/svg+xml"}}]})}]})]
(t/is (nil? (:error upd)) (str "update-file failed: " (pr-str (:error upd))))
[file (:id sobj)]))
(defn- export-v1
"Export `file` to v1 and return the bundle path."
[profile file]
(let [bundle (tmp/tempfile :prefix "penpot-export-v1-" :suffix ".bin")]
(v1/export-files!
(-> th/*system*
(assoc ::bfc/ids #{(:id file)})
(assoc ::bfc/embed-assets false)
(assoc ::bfc/include-libraries false))
(io/output-stream bundle))
bundle))
(defn- export-import-v1
"Export `file` to v1, import it back and return the served bytes
of its single media object."
[profile file]
(let [bundle (export-v1 profile file)]
(let [result (-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input (io/input-stream bundle))
(v1/import-files!))]
(t/is (= 1 (count result)))
(let [rows (th/db-query :file-media-object {:file-id (first result)})
storage (:app.storage/storage th/*system*)]
(t/is (= 1 (count rows)))
(let [object (sto/get-object storage (:media-id (first rows)))]
[(bytes-str (sto/get-object-bytes storage object))
(:content-type (meta object))])))))
(t/deftest import-binfile-v1-sanitizes-seeded-svg
(let [profile (th/create-profile* 4)
[file _seed] (seed-file-with-svg-media profile 4 evil-svg "IMAGE/SVG+XML")
[served stored] (export-import-v1 profile file)]
(t/is (not (str/includes? served "<script")))
(t/is (not (str/includes? served "PWNMARK_SCRIPT")))
(t/is (= "image/svg+xml" stored))))
(t/deftest import-binfile-v1-rejects-unknown-content-type
(let [profile (th/create-profile* 6)
[file _seed] (seed-file-with-svg-media profile 6 evil-svg "text/html")
bundle (export-v1 profile file)
out (try
(-> th/*system*
(assoc ::bfc/project-id (:default-project-id profile))
(assoc ::bfc/profile-id (:id profile))
(assoc ::bfc/input (io/input-stream bundle))
(v1/import-files!))
nil
(catch clojure.lang.ExceptionInfo e
(ex-data e)))]
(t/is (= :validation (:type out)))
(t/is (= :media-type-not-allowed (:code out)))
(t/is (= [(:id file)]
(mapv :id (th/db-query :file {:project-id (:default-project-id profile)}))))))
(def ^:private large-clean-svg
(let [pad (apply str (repeat 110000 "<!--0123456789ABCDEF-->"))]
(str "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"64\" height=\"64\">" pad "<circle r=\"20\"/></svg>")))
(t/deftest import-binfile-v1-roundtrips-large-svg
(t/testing "objects over the tempfile threshold (tempfile branch) import fine"
(t/is (> (alength (utf8bytes large-clean-svg)) bfc/temp-file-threshold))
(let [profile (th/create-profile* 5)
[file _seed] (seed-file-with-svg-media profile 5 large-clean-svg "image/svg+xml")
[served _stored] (export-import-v1 profile file)]
(t/is (str/includes? served "circle")))))

9
backend/test/backend_tests/binfile_test.clj
View File

@ -1985,7 +1985,7 @@
(let [storage (-> (:app.storage/storage th/*system*)
(stt/configure-storage-backend))
sobject (sto/put-object! storage {::sto/content (sto/content "media-bytes")
sobject (sto/put-object! storage {::sto/content (sto/content "<svg xmlns=\"http://www.w3.org/2000/svg\"/>")
:content-type "image/svg+xml"
:bucket "file-media-object"})
@ -2161,6 +2161,13 @@
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out))))))
(t/deftest default-text-total-budget-fits-giant-legit-files
;; A real-world giant export held ~437 MiB of JSON across ~178k
;; KB-sized entries without tripping any per-entry cap. The default
;; cumulative budget must clear that scale, or such files cannot be
;; imported out of the box.
(t/is (>= bfc/default-max-text-total-size (* 1024 1024 450))))
(defn- text-entries-sizes
"Returns the decompressed sizes of every `.json` entry in the zip at
`zip-path`. Used to pick a cumulative budget that sits between the

693
backend/test/backend_tests/climit_test.clj Normal file
View File

@ -0,0 +1,693 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns backend-tests.climit-test
(:require
[app.common.logging :as l]
[app.common.uuid :as uuid]
[app.main :as main]
[app.metrics :as mtx]
[app.rpc :as-alias rpc]
[app.rpc.climit :as climit]
[app.util.services :as-alias sv]
[backend-tests.helpers :as th]
[clojure.edn :as edn]
[clojure.java.io :as io]
[clojure.test :as t]
[integrant.core :as ig]))
(def ^:private calls (atom []))
(defn- record-metrics
"Run `f` recording every metrics call it makes."
[f]
(reset! calls [])
(with-redefs [mtx/run!
(fn [_ & {:keys [id labels val]}]
(swap! calls conj {:id id :labels (vec labels) :val val}))]
(f)))
(defn- acquired-in-order
"Limiter names acquired so far, in acquisition order."
[]
(->> @calls
(filter #(= :rpc-climit-timing (:id %)))
(mapcat :labels)
(vec)))
(defn- saw-call?
"Wait until a metrics call mentions `label`."
[label timeout]
(let [deadline (+ (System/currentTimeMillis) timeout)]
(loop []
(cond
(some (fn [call] (some #{label} (:labels call))) @calls)
true
(> (System/currentTimeMillis) deadline)
false
:else
(do (Thread/sleep 10) (recur))))))
(defn- failed-type
"Run `f` and return its value, or the type of the error it raised."
[f]
(try
(f)
(catch Throwable cause
(:type (ex-data cause)))))
(def ^:private no-timeout-hint
"limiter without timeout, a saturated one parks its threads forever")
(defn- warned-ids
"Ids of the captured log records that warn about a missing timeout."
[records]
(->> records
(keep (fn [record]
(when (= no-timeout-hint (get (::l/props record) :hint))
(get (::l/props record) :id))))
(set)))
(defn- warned?
"Wait until a captured log record warns about a missing timeout."
[records timeout]
(let [deadline (+ (System/currentTimeMillis) timeout)]
(loop []
(cond
(seq (warned-ids @records)) true
(> (System/currentTimeMillis) deadline) false
:else (do (Thread/sleep 10) (recur))))))
;; One permit and a bounded wait per limiter: a call either gets its permit, or
;; fails with a concurrency limit error, never parks a thread forever.
(def ^:private test-config
{:root/global {:permits 1 :timeout 3000}
:root/by-profile {:permits 1 :timeout 3000}
:process-image/global {:permits 1 :timeout 3000}
:process-image/by-profile {:permits 1 :timeout 3000}})
;; The limits `upload-file-media-object` and `assemble-file-media-object`
;; declare, per profile.
(def ^:private image-limits
[[:process-image/by-profile ::rpc/profile-id]
[:process-image/global]])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ACQUISITION ORDER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest acquires-root-limits-before-the-command-own-limits
;; A command declaring its own limits must meet the root limiters first.
;; The nested `climit/invoke!` calls take only the command's own limits and
;; run inside the root ones, so any other order lets two calls of the same
;; profile hold the same limiters in opposite order and park for good.
(record-metrics
(fn []
(th/with-climit [climit test-config]
(let [mdata {::sv/name "test-command" ::climit/id image-limits}
wrapped (climit/wrap {::rpc/climit climit} (fn [_ _] :ok) mdata)
result (wrapped {::rpc/climit climit} {::rpc/profile-id (uuid/next)})]
(t/is (= :ok result))
(t/is (= ["root/by-profile"
"root/global"
"process-image/by-profile"
"process-image/global"]
(acquired-in-order))))))))
(t/deftest nested-limits-do-not-deadlock-with-the-command-own-limits
;; Two paths over one profile: a command declaring its own limits (like
;; `upload-file-media-object`) and a command that takes the root limiters and
;; then asks for the same limits from inside its handler (like
;; `create-file-media-object-from-url`). Each path holds what the other one
;; waits for the moment the order differs, and nothing releases.
(record-metrics
(fn []
(th/with-climit [climit test-config]
(let [pid (uuid/next)
gate (promise)
entered (promise)
handler-b (fn [cfg params]
(deliver entered true)
@gate
(-> cfg
(assoc ::climit/id [[:process-image/by-profile pid]
[:process-image/global]])
(assoc ::climit/label "path-b")
(climit/invoke! (fn [_ _] :nested-ok) params)))
wrapped-a (climit/wrap {::rpc/climit climit}
(fn [_ _] :ok)
{::sv/name "path-a" ::climit/id image-limits})
wrapped-b (climit/wrap {::rpc/climit climit}
handler-b
{::sv/name "path-b"})]
;; Path B takes the root limiters and waits inside its handler.
(let [fb (future (failed-type #(wrapped-b {::rpc/climit climit}
{::rpc/profile-id pid})))]
(t/is (true? (deref entered 5000 false)))
;; Path A, started now, takes its own limiters and then waits for the
;; root ones, which B holds. The recorded metrics are how the test
;; knows A got that far instead of guessing with a sleep.
(reset! calls [])
(let [fa (future (failed-type #(wrapped-a {::rpc/climit climit}
{::rpc/profile-id pid})))]
(t/is (true? (saw-call? "root/by-profile" 5000)))
;; Let B ask for the limits A holds: if the order differs, each path
;; now waits for a permit the other one holds.
(deliver gate true)
(t/is (= :ok (deref fa 15000 :timeout)))
(t/is (= :nested-ok (deref fb 15000 :timeout))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REENTRANCY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest reentrant-invoke-does-not-consume-a-second-permit
;; A handler entering climit for a limit it already holds must not queue
;; behind itself: it runs inline and takes no second permit. Another thread
;; asking for the same limiter still waits, so the limit stays in place.
(th/with-climit [climit {:process-image/by-profile
{:permits 1 :timeout 2000}}]
(let [pid (uuid/next)
cfg {::rpc/climit climit
::climit/id [[:process-image/by-profile pid]]}
inner (promise)
other (promise)
handler (fn [cfg params]
(deliver inner
(failed-type #(climit/invoke! cfg (fn [_ _] :inner-ok) params)))
(deliver other (future (climit/invoke! cfg (fn [_ _] :other-ok) params)))
(t/is (= :waiting (deref @other 300 :waiting)))
:outer-ok)
outcome (failed-type #(climit/invoke! cfg handler {}))]
;; With no reentrancy handling the inner call waits for the permit this very
;; thread holds and ends failing by timeout.
(t/is (= :inner-ok (deref inner 5000 :timeout)))
(t/is (= :outer-ok outcome))
;; once the outer call releases, the other thread gets its permit
(t/is (= :other-ok (deref @other 5000 :timeout))))))
(t/deftest reentrant-tracking-is-cleaned-up-when-the-handler-fails
;; If the mark is not removed, the thread keeps believing it holds the
;; limiter and every later call of that key would skip the limit.
(th/with-climit [climit {:process-image/by-profile
{:permits 1 :timeout 1000}}]
(let [pid (uuid/next)
cfg {::rpc/climit climit
::climit/id [[:process-image/by-profile pid]]}
holding (promise)
gate (promise)]
;; The failing call runs on this thread, so this thread is the one that
;; must forget it held the limiter.
(t/is (thrown? clojure.lang.ExceptionInfo
(climit/invoke! cfg (fn [_ _] (throw (ex-info "boom" {}))) {})))
;; another thread takes the only permit
(let [fb (future (climit/invoke! cfg (fn [_ _]
(deliver holding true)
@gate
:held)
{}))]
(t/is (true? (deref holding 5000 false)))
;; this thread must wait for it, not skip the limiter
(t/is (= :concurrency-limit
(failed-type #(climit/invoke! cfg (fn [_ _] :inner-ok) {}))))
(deliver gate true)
(t/is (= :held (deref fb 5000 :timeout)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SHIPPED CONFIG
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest example-config-bounds-every-wait
;; A limiter without `:timeout` parks the calling thread forever, which is
;; how a limit nobody releases turns into lost worker threads and days of
;; silent 429s. Every entry of the shipped config must carry one.
(let [path (io/resource "climit.edn")]
(t/is (some? path))
(let [data (edn/read-string (slurp path))]
(t/is (seq data))
(doseq [[id config] data]
(t/is (int? (:timeout config))
(str id " must declare a timeout"))))))
(t/deftest warns-when-a-limiter-has-no-timeout
;; The config that production loads lives outside the repository and is
;; maintained by hand, so a limiter without a timeout has to say so at
;; startup instead of parking threads in silence months later.
(let [records (atom [])]
(add-watch l/log-record ::capture
(fn [_ _ _ record] (swap! records conj record)))
(try
(th/with-climit [_climit {:process-image/by-profile {:permits 1 :timeout 1000}
:process-image/global {:permits 8}}]
(t/is (true? (warned? records 2000)))
(t/is (= #{:process-image/global} (warned-ids @records))))
(finally
(remove-watch l/log-record ::capture)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WAITING COUNTER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- waiting-value-of
"Values published to the waiting gauge for one limiter name, in order."
[name]
(->> @calls
(filter #(= :rpc-climit-waiting (:id %)))
(filter #(= name (first (:labels %))))
(map :val)
(vec)))
(defn- waiting-last
"Last value published to the waiting gauge for one limiter name. How many
publications land inside a window is not part of the contract, the value is,
so this is what the assertions read."
[name]
(last (waiting-value-of name)))
(defn- waiting-count
"Current waiting count of a limiter name, read from its component."
[climit name]
(.get ^java.util.concurrent.atomic.AtomicLong
(#'climit/waiting-counter (:counters climit) name)))
(defn- wait-until
"Wait until `pred` holds, or give up."
[pred timeout]
(let [deadline (+ (System/currentTimeMillis) timeout)]
(loop []
(cond
(pred) true
(> (System/currentTimeMillis) deadline) false
:else (do (Thread/sleep 10) (recur))))))
(defn- limiter-name
"The name climit publishes for a limiter id: the keyword without the colon."
[id]
(subs (str id) 1))
(defn- limiter-cfg
[climit name key]
{::rpc/climit climit
::climit/id [[name key]]})
(t/deftest waiting-gauge-follows-the-queue
;; The value is the number of calls waiting for a permit: up when a call
;; starts waiting, down when the wait ends. The gauges that sampled the
;; limiter stats could not show this, because the value of whichever limiter
;; of the name ran last was the one that survived.
(record-metrics
(fn []
(th/with-climit [climit {:test-waiting/by-profile {:permits 1 :timeout 3000}}]
(let [name (limiter-name :test-waiting/by-profile)
entered (promise)
gate (promise)
holder (future (climit/invoke! (limiter-cfg climit :test-waiting/by-profile "a")
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
;; the holder is running, not waiting
(reset! calls [])
(let [waiter (future (climit/invoke! (limiter-cfg climit :test-waiting/by-profile "a")
(fn [_ _] :waited)
{}))]
(t/is (true? (wait-until #(= 1 (waiting-last name)) 5000)))
(t/is (= 1 (waiting-count climit name)))
(deliver gate true)
(t/is (= :waited (deref waiter 5000 :timeout)))
(t/is (= :held (deref holder 5000 :timeout)))
(t/is (true? (wait-until #(= 0 (waiting-last name)) 5000)))
(t/is (= 0 (waiting-count climit name)))))))))
(t/deftest waiting-gauge-sums-every-key-of-a-name
;; Two profiles queueing on the same limiter name add up. That is the shape
;; that stayed invisible in production: one series per name, counting the
;; entries and the exits, instead of one value per limiter overwritten by the
;; next one.
(record-metrics
(fn []
(th/with-climit [climit {:test-waiting-keys/by-profile {:permits 1 :timeout 3000}}]
(let [name (limiter-name :test-waiting-keys/by-profile)
gates {:a (promise) :b (promise)}
holders
(into {}
(map (fn [k]
(let [entered (promise)]
[k {:entered entered
:future (future (climit/invoke! (limiter-cfg climit :test-waiting-keys/by-profile k)
(fn [_ _]
(deliver entered true)
@(gates k)
:held)
{}))}])))
[:a :b])]
(doseq [k [:a :b]]
(t/is (true? (deref (:entered (holders k)) 5000 false))))
;; one call per key, waiting behind its own holder
(let [waiters (into {}
(map (fn [k]
[k (future (climit/invoke! (limiter-cfg climit :test-waiting-keys/by-profile k)
(fn [_ _] :waited)
{}))]))
[:a :b])]
(t/is (true? (wait-until #(= 2 (waiting-count climit name)) 5000)))
;; the increment that reaches 2 always publishes 2, whichever waiter
;; does it last: the order of two concurrent publications is not the
;; contract, the value is.
(t/is (some #(= 2 %) (waiting-value-of name)))
(doseq [k [:a :b]] (deliver (gates k) true))
(doseq [k [:a :b]]
(t/is (= :waited (deref (waiters k) 5000 :timeout)))
(t/is (= :held (deref (:future (holders k)) 5000 :timeout))))
(t/is (true? (wait-until #(= 0 (waiting-count climit name)) 5000)))
(t/is (some #(= 0 %) (waiting-value-of name)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; REJECTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- rejections
"Rejections published, as [name reason] pairs."
[]
(->> @calls
(filter #(= :rpc-climit-rejected (:id %)))
(map (fn [call] [(first (:labels call)) (second (:labels call))]))
(vec)))
(t/deftest rejection-counter-tells-why
;; Rejections had no metric: the panel counted them from the logs. Now a call
;; rejected because the queue is full and a call rejected because it waited
;; too long are counted apart.
(record-metrics
(fn []
(th/with-climit [climit {:test-rejected/by-profile {:permits 1 :queue 1 :timeout 60000}}]
(let [name (limiter-name :test-rejected/by-profile)
cfg (limiter-cfg climit :test-rejected/by-profile "a")
entered (promise)
gate (promise)
holder (future (climit/invoke! cfg
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
(reset! calls [])
;; the queue holds one waiter, so the next call is rejected right away
(let [queued (future (failed-type #(climit/invoke! cfg (fn [_ _] :queued) {})))]
(t/is (true? (wait-until #(= 1 (waiting-last name)) 5000)))
(t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :extra) {}))))
(t/is (= [[name "queue-full"]] (rejections)))
(deliver gate true)
(t/is (= :held (deref holder 5000 :timeout)))
(t/is (= :queued (deref queued 5000 :timeout))))))
;; a wait that times out is counted as such, not as a full queue
(th/with-climit [climit {:test-timeout/by-profile {:permits 1 :timeout 300}}]
(let [name (limiter-name :test-timeout/by-profile)
cfg (limiter-cfg climit :test-timeout/by-profile "a")
entered (promise)
gate (promise)
holder (future (climit/invoke! cfg
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
(reset! calls [])
(t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :late) {}))))
(t/is (= [[name "timeout"]] (rejections)))
(deliver gate true)
(t/is (= :held (deref holder 5000 :timeout))))))))
(t/deftest the-waiting-count-comes-back-after-a-rejection
;; A rejected call increments and decrements exactly once: a limiter that
;; rejects under pressure must not drift the panel up.
(record-metrics
(fn []
(th/with-climit [climit {:test-rejected-baseline/by-profile {:permits 1 :queue 0 :timeout 3000}}]
(let [name (limiter-name :test-rejected-baseline/by-profile)
cfg (limiter-cfg climit :test-rejected-baseline/by-profile "a")
entered (promise)
gate (promise)
holder (future (climit/invoke! cfg
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
(reset! calls [])
(t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :extra) {}))))
(t/is (= 0 (waiting-count climit name)))
(t/is (true? (wait-until #(= 0 (waiting-last name)) 5000)))
(deliver gate true)
(t/is (= :held (deref holder 5000 :timeout))))))))
(t/deftest the-waiting-count-comes-back-when-the-handler-throws
;; A handler that throws still leaves the count where it was.
(record-metrics
(fn []
(th/with-climit [climit {:test-handler-throws/by-profile {:permits 1 :timeout 3000}}]
(let [name (limiter-name :test-handler-throws/by-profile)
cfg (limiter-cfg climit :test-handler-throws/by-profile "a")]
(reset! calls [])
(t/is (thrown? clojure.lang.ExceptionInfo
(climit/invoke! cfg (fn [_ _] (throw (ex-info "boom" {}))) {})))
(t/is (= 0 (waiting-count climit name)))
(t/is (true? (wait-until #(= 0 (waiting-last name)) 5000))))))))
(defn- failing-first-waiting-publish
"A `mtx/run!` replacement that fails the first waiting publication and records
the rest, so the decrement of the unwinding path still lands."
[calls]
(let [pending (atom true)]
(fn [_ & {:keys [id labels val]}]
(if (and @pending (= :rpc-climit-waiting id))
(do (reset! pending false)
(throw (ex-info "publishing is down" {})))
(swap! calls conj {:id id :labels (vec labels) :val val})))))
(t/deftest a-throwable-while-waiting-leaves-no-mark-and-no-count
;; `waiting-inc` sits inside the `try`: a throwable from the publishing path
;; unwinds through the `finally`, so the thread neither keeps the limiter
;; marked as held (it would skip that limiter for that key for ever) nor
;; leaves the count up.
(th/with-climit [climit {:test-throw-waiting/by-profile {:permits 1 :timeout 3000}}]
(let [name (limiter-name :test-throw-waiting/by-profile)
cfg (limiter-cfg climit :test-throw-waiting/by-profile "a")]
(reset! calls [])
(with-redefs [mtx/run! (failing-first-waiting-publish calls)]
(t/is (thrown? clojure.lang.ExceptionInfo
(climit/invoke! cfg (fn [_ _] :never) {}))))
;; the count came back down instead of staying up for good
(t/is (= 0 (waiting-count climit name)))
(t/is (= [0] (waiting-value-of name)))
;; and the thread dropped the mark: with it left behind, this call would
;; run inline instead of waiting for the permit another thread holds.
(let [entered (promise)
gate (promise)
holder (future (climit/invoke! cfg
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
(t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :inline) {}))))
(deliver gate true)
(t/is (= :held (deref holder 5000 :timeout)))))))
(defn- gauge-value
"Current value of the waiting gauge for one limiter name, read from a real
prometheus collector."
[metrics name]
(let [collector (:app.metrics.definition/instance
(mtx/get-collector metrics :rpc-climit-waiting))]
(.get ^io.prometheus.client.Gauge$Child
(.labels ^io.prometheus.client.Gauge collector (into-array String [name])))))
(t/deftest the-waiting-gauge-reaches-a-real-registry
;; The recorded calls prove the arguments, not that a collector with that name
;; and those labels exists: a typo in the metric id or a wrong label arity
;; would only show up in production. Here the value is read back from a real
;; prometheus registry.
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
name (limiter-name :test-registry/by-profile)]
(th/with-climit [climit {:test-registry/by-profile {:permits 1 :timeout 3000}} metrics]
(let [cfg (limiter-cfg climit :test-registry/by-profile "a")
entered (promise)
gate (promise)
holder (future (climit/invoke! cfg
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
(let [waiter (future (climit/invoke! cfg (fn [_ _] :waited) {}))]
(t/is (true? (wait-until #(= 1.0 (gauge-value metrics name)) 5000)))
(deliver gate true)
(t/is (= :waited (deref waiter 5000 :timeout)))
(t/is (= :held (deref holder 5000 :timeout)))
(t/is (true? (wait-until #(= 0.0 (gauge-value metrics name)) 5000))))))))
(defn- rejected-record
"The first captured log record that reports a rejection with `reason`."
[records reason]
(let [deadline (+ (System/currentTimeMillis) 5000)]
(loop []
(let [record (first (filter (fn [record]
(let [props (::l/props record)]
(and (= "rejected" (get props :hint))
(= reason (get props :reason)))))
@records))]
(cond
record record
(> (System/currentTimeMillis) deadline) nil
:else (do (Thread/sleep 10) (recur)))))))
(t/deftest rejection-logs-say-why-and-how-big-the-limits-are
;; The line has to say whether the queue was full or the wait timed out, and
;; how many permits and how much queue the limiter has, or nobody can tell
;; whether the limiter did its job.
(let [records (atom [])]
(add-watch l/log-record ::capture
(fn [_ _ _ record] (swap! records conj record)))
(try
(record-metrics
(fn []
(th/with-climit [climit {:test-log/by-profile {:permits 1 :queue 2 :timeout 60000}}]
(let [name (limiter-name :test-log/by-profile)
cfg (limiter-cfg climit :test-log/by-profile "a")
entered (promise)
gate (promise)
holder (future (climit/invoke! cfg
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
(reset! calls [])
(let [q1 (future (climit/invoke! cfg (fn [_ _] :q1) {}))
q2 (future (climit/invoke! cfg (fn [_ _] :q2) {}))]
;; the two of them fill the queue, so the next one is rejected
(t/is (true? (wait-until #(= 2 (waiting-count climit name)) 5000)))
(t/is (some #(= 2 %) (waiting-value-of name)))
(t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :x) {}))))
(let [props (::l/props (rejected-record records "queue-full"))]
(t/is (= 1 (get props :permits)))
(t/is (= 2 (get props :queue-max)))
(t/is (= :capacity-limit-reached (get props :code)))
(t/is (= "queue-full" (get props :reason))))
(deliver gate true)
(t/is (= :held (deref holder 5000 :timeout)))
(deref q1 5000 nil)
(deref q2 5000 nil))))
;; A wait that times out carries its own reason in the line, next to the
;; code the limiter raised. The line is emitted at TRACE when nothing
;; else is left queued behind it (the caller was the only one waiting),
;; so the call to `log` is captured instead of the record, which the
;; logger would drop.
(th/with-climit [climit {:test-log-timeout/by-profile {:permits 1 :timeout 300}}]
(let [cfg (limiter-cfg climit :test-log-timeout/by-profile "a")
lines (atom [])
entered (promise)
gate (promise)
capture (fn [_ action _req-id _stats _elapsed code reason]
(swap! lines conj [action code reason]))
holder (future (climit/invoke! cfg
(fn [_ _] (deliver entered true) @gate :held)
{}))]
(t/is (true? (deref entered 5000 false)))
(with-redefs [climit/log capture]
(t/is (= :concurrency-limit (failed-type #(climit/invoke! cfg (fn [_ _] :late) {}))))
(t/is (= [["rejected" :capacity-limit-reached "timeout"]]
(filterv #(= "rejected" (first %)) @lines))))
(deliver gate true)
(t/is (= :held (deref holder 5000 :timeout)))))))
(finally
(remove-watch l/log-record ::capture)))))
(t/deftest republish-writes-the-current-waiting-count
;; A call that never comes back keeps the count up, but if it is also the
;; last thing that happened nothing rewrites that series and it goes stale in
;; the scrape. The republish is what keeps it visible. The counters are built
;; on their own: with a component, its sampler would also publish the same
;; count the moment its first tick lands inside the window.
(let [counters (#'climit/create-waiting-counters)
name (limiter-name :test-republish/by-profile)
counter ^java.util.concurrent.atomic.AtomicLong (#'climit/waiting-counter counters name)]
(.set counter 3)
(record-metrics
(fn []
(#'climit/republish-waiting (th/metrics-stub) counters)
(t/is (= [3] (waiting-value-of name)))))))
(t/deftest halting-the-component-stops-the-republisher
;; The republisher is a daemon thread started with the component: halting it
;; has to stop the thread, or every restart leaves another one running.
(let [climit (th/init-climit {:test-halt/by-profile {:permits 1 :timeout 3000}})
sampler ^java.util.concurrent.ScheduledThreadPoolExecutor (:sampler climit)]
(t/is (false? (.isShutdown sampler)))
(ig/halt-key! ::rpc/climit climit)
(t/is (true? (.isShutdown sampler)))))
(t/deftest the-climit-metrics-that-remain-are-defined
;; A typo in a metric id, or a definition that is not there, makes the
;; publishing silent, which is the failure mode this work removes. And the
;; gauges that could not tell the truth must be gone.
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})]
(t/is (= ["name"]
(:app.metrics.definition/labels (mtx/get-collector metrics :rpc-climit-waiting))))
(t/is (= ["name" "reason"]
(:app.metrics.definition/labels (mtx/get-collector metrics :rpc-climit-rejected))))
(t/is (some? (mtx/get-collector metrics :rpc-climit-timing)))
(t/is (nil? (mtx/get-collector metrics :rpc-climit-queue)))
(t/is (nil? (mtx/get-collector metrics :rpc-climit-permits)))
(t/is (nil? (mtx/get-collector metrics :http-worker-busy-threads)))))

20
backend/test/backend_tests/config_test.clj
View File

@ -6,6 +6,7 @@
(ns backend-tests.config-test
(:require
[app.common.time :as ct]
[app.config :as cf]
[clojure.test :as t]))
@ -51,11 +52,26 @@
(t/testing "schema decodes all runner parallelism keys (env strings to int)"
(let [decoded (cf/decode-config {:worker-default-parallelism "4"
:worker-webhook-parallelism "2"
:worker-cron-parallelism "3"})]
:worker-cron-parallelism "3"
:worker-binfile-parallelism "5"})]
(t/is (= 4 (:worker-default-parallelism decoded)))
(t/is (= 2 (:worker-webhook-parallelism decoded)))
(t/is (= 3 (:worker-cron-parallelism decoded)))))
(t/is (= 3 (:worker-cron-parallelism decoded)))
(t/is (= 5 (:worker-binfile-parallelism decoded)))))
(t/testing "lookups resolve configured values (unnamespaced keys, as main uses)"
(with-redefs [cf/config (assoc cf/config
:worker-default-parallelism 4)]
(t/is (= 4 (cf/get :worker-default-parallelism 1))))))
(t/deftest jobs-user-ttl
(t/testing "the env value is decoded as a duration"
(let [decoded (cf/decode-config {:jobs-user-ttl "72h"})]
(t/is (= (ct/duration {:days 3}) (:jobs-user-ttl decoded)))))
(t/testing "the getter resolves the configured value"
(with-redefs [cf/config (assoc cf/config :jobs-user-ttl (ct/duration {:days 1}))]
(t/is (= (ct/duration {:days 1}) (cf/get-jobs-user-ttl)))))
(t/testing "and falls back to a week"
(with-redefs [cf/config (dissoc cf/config :jobs-user-ttl)]
(t/is (= (ct/duration {:days 7}) (cf/get-jobs-user-ttl))))))

81
backend/test/backend_tests/health_test.clj Normal file
View File

@ -0,0 +1,81 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns backend-tests.health-test
(:require
[app.common.exceptions :as ex]
[app.db :as db]
[app.health :as health]
[app.http.debug :as debug]
[app.srepl.main :as srepl]
[backend-tests.helpers :as th]
[clojure.test :as t]
[yetti.response :as-alias yres]))
(t/use-fixtures :once th/state-init)
(defn- restore-availability
"The availability flag is a global atom shared by the whole test JVM, so
every test leaves the instance online."
[next]
(try
(next)
(finally
(health/set-online))))
(t/use-fixtures :each (th/serial th/database-reset restore-availability))
;; ----------------------------------------------------------------
;; Tests: app.health state
;; ----------------------------------------------------------------
(t/deftest instance-is-online-by-default
(t/is (true? (health/online?))))
(t/deftest set-offline-and-set-online-toggle-the-flag
(health/set-offline)
(t/is (false? (health/online?)))
(health/set-online)
(t/is (true? (health/online?))))
;; ----------------------------------------------------------------
;; Tests: /readyz handler
;; ----------------------------------------------------------------
(t/deftest readyz-reports-ok-when-instance-is-online
(let [response (debug/health-handler th/*system* {})]
(t/is (= 200 (::yres/status response)))
(t/is (= "OK" (::yres/body response)))))
(t/deftest readyz-reports-unavailable-when-instance-is-offline
(health/set-offline)
(let [response (debug/health-handler th/*system* {})]
(t/is (= 503 (::yres/status response)))
(t/is (= "OFFLINE" (::yres/body response)))))
(t/deftest readyz-does-not-query-the-database-when-instance-is-offline
(health/set-offline)
(with-redefs [db/exec-one! (fn [_ _]
(throw (ex-info "database unreachable" {})))]
(let [response (debug/health-handler th/*system* {})]
(t/is (= 503 (::yres/status response)))
(t/is (= "OFFLINE" (::yres/body response))))))
;; ----------------------------------------------------------------
;; Tests: srepl helpers (the operator entry points)
;; ----------------------------------------------------------------
(t/deftest srepl-helpers-change-the-readyz-answer
(srepl/set-offline)
(let [drained (debug/health-handler th/*system* {})]
(t/is (= 503 (::yres/status drained)))
(t/is (= "OFFLINE" (::yres/body drained))))
(srepl/set-online)
(let [restored (debug/health-handler th/*system* {})]
(t/is (= 200 (::yres/status restored)))
(t/is (= "OK" (::yres/body restored)))))

62
backend/test/backend_tests/helpers.clj
View File

@ -24,9 +24,11 @@
[app.main :as main]
[app.media]
[app.media :as-alias mtx]
[app.metrics :as-alias metrics]
[app.migrations]
[app.msgbus :as-alias mbus]
[app.rpc :as-alias rpc]
[app.rpc.climit :as-alias climit]
[app.rpc.commands.auth :as cmd.auth]
[app.rpc.commands.files :as files]
[app.rpc.commands.files-create :as files.create]
@ -102,6 +104,22 @@
(fs/create-dir "/tmp/penpot")
(next)))))
(defn- remove-job-runners
"Drops every `[<profile> :app.worker/runner]` from the system.
The tests drive the runner loop by hand (`wdisp/run-batch` plus
`run-worker-loop` over a system they build themselves), so a live runner
of any queue races them: it takes the job the test just dispatched and
completes it behind the test's back. Matching the key by shape, instead
of listing the known queues by hand, keeps a new queue from silently
bringing that race back (which is what happened to the `binfile` runner
this key list was missing)."
[system]
(apply dissoc system
(filter #(and (vector? %)
(= :app.worker/runner (second %)))
(keys system))))
(defn init-system
[next]
(let [templates [{:id "test"
@ -132,10 +150,8 @@
:app.loggers.mattermost/reporter
:app.loggers.database/reporter
:app.worker/cron
:app.worker/dispatcher
[:app.main/default :app.worker/runner]
[:app.main/webhook :app.worker/runner]
[:app.main/cron :app.worker/runner]))
:app.worker/dispatcher)
(remove-job-runners))
_ (ig/load-namespaces system)
system (-> (ig/expand system) (ig/init))]
(try
@ -309,9 +325,7 @@
([params] (create-project-role* *system* params))
([system {:keys [project-id profile-id role] :or {role :owner}}]
(dm/with-open [conn (db/open system)]
(#'teams/create-project-role conn {:project-id project-id
:profile-id profile-id
:role role}))))
(#'teams/create-project-role conn profile-id project-id role))))
(defn create-file-role*
([params] (create-file-role* *system* params))
@ -535,6 +549,40 @@
(assoc ::jobs/context (jobs/make-context row))
(assoc ::jobs/job-id (:id row)))))))))
(defn metrics-stub
"A metrics instance with no collectors, where every `run!` is a no-op."
[]
(reify metrics/IMetrics
(get-handler [_] nil)
(get-collector [_ _] nil)
(get-registry [_] nil)))
(defn init-climit
"Build a concurrency limiter component from an inline config map. The
optional second argument is the metrics instance to publish to (a
`metrics-stub` by default, where every `run!` is a no-op)."
([config]
(init-climit config (metrics-stub)))
([config metrics]
(let [file (doto (java.io.File/createTempFile "climit" ".edn")
(.deleteOnExit))]
(spit file (pr-str config))
(ig/init-key ::rpc/climit
{::climit/enabled true
::climit/config (.getAbsolutePath file)
::metrics/metrics metrics}))))
(defmacro with-climit
"Build a concurrency limiter from an inline config map, run the body and
halt it, so the republisher thread it starts never outlives the test. An
optional third binding element is the metrics instance to publish to."
[[sym config & [metrics]] & body]
`(let [~sym (init-climit ~config ~@(when metrics [metrics]))]
(try
~@body
(finally
(ig/halt-key! ::rpc/climit ~sym)))))
;; --- UTILS
(defn print-error!

42
backend/test/backend_tests/http_assets_test.clj
View File

@ -887,6 +887,48 @@
response (assets/objects-handler cfg request)]
(t/is (= 204 (::yres/status response)))))
;; ----------------------------------------------------------------
;; Tests: objects-handler — job-resource bucket ownership
;; ----------------------------------------------------------------
(t/deftest objects-handler-job-resource-owner-can-access
(let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend))
cfg (make-handler-cfg storage)
owner (th/create-profile* 1)
object (create-storage-object! storage "job-resource" "artifact" {:profile-id (:id owner)})
request {:path-params {:id (str (:id object))}
::session/profile-id (:id owner)}
response (assets/objects-handler cfg request)]
(t/is (= 204 (::yres/status response)))))
(t/deftest objects-handler-job-resource-non-owner-gets-404
;; The artifact of a job belongs to the profile that owns the job.
(let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend))
cfg (make-handler-cfg storage)
owner (th/create-profile* 1)
stranger (th/create-profile* 2)
object (create-storage-object! storage "job-resource" "artifact" {:profile-id (:id owner)})
request {:path-params {:id (str (:id object))}
::session/profile-id (:id stranger)}
response (assets/objects-handler cfg request)]
(t/is (= 404 (::yres/status response)))))
(t/deftest objects-handler-job-resource-released-object-gets-404
;; Once the job is gone and the GC has reclaimed the artifact, the route
;; has nothing to serve.
(let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend))
cfg (make-handler-cfg storage)
owner (th/create-profile* 1)
object (create-storage-object! storage "job-resource" "artifact" {:profile-id (:id owner)})
request {:path-params {:id (str (:id object))}
::session/profile-id (:id owner)}]
(t/is (= 204 (::yres/status (assets/objects-handler cfg request))))
(sto/del-object! storage (:id object))
(t/is (= 404 (::yres/status (assets/objects-handler cfg request))))))
;; ----------------------------------------------------------------
;; Tests: asset request metrics
;; ----------------------------------------------------------------

40
backend/test/backend_tests/http_metrics_test.clj
View File

@ -16,7 +16,6 @@
io.prometheus.client.Counter
io.prometheus.client.Gauge
io.undertow.server.ConnectorStatistics
java.util.concurrent.ScheduledThreadPoolExecutor
org.xnio.management.XnioWorkerMXBean))
(t/use-fixtures :once th/state-init)
@ -29,9 +28,6 @@
{:http-worker-queue-size {:name "penpot_http_worker_queue_size"
:help "test"
:type :gauge}
:http-worker-busy-threads {:name "penpot_http_worker_busy_threads"
:help "test"
:type :gauge}
:http-worker-pool-size {:name "penpot_http_worker_pool_size"
:help "test"
:type :gauge}
@ -132,23 +128,20 @@
(http/sample-worker-metrics metrics mxbean)
(t/is (= 2.0 (gauge-value (collector-instance metrics :http-worker-queue-size))))
(t/is (= 10.0 (gauge-value (collector-instance metrics :http-worker-busy-threads))))
(t/is (= 40.0 (gauge-value (collector-instance metrics :http-worker-pool-size))))
(t/is (= 512.0 (gauge-value (collector-instance metrics :http-worker-max-pool-size))))))
(t/deftest sample-worker-metrics-skips-negative-samples
;; the xnio MXBean occasionally returns -1 on the busy thread count;
;; a negative value is a missing measurement, not a zero.
;; the xnio MXBean occasionally returns -1 on a count; a negative value is a
;; missing measurement, not a zero.
(let [metrics (fake-metrics)
mxbean (fake-mxbean {:queue 0 :busy -1 :pool 4 :max 512})]
mxbean (fake-mxbean {:queue -1 :busy -1 :pool 4 :max 512})]
(http/sample-worker-metrics metrics mxbean)
(t/is (= 0.0 (gauge-value (collector-instance metrics :http-worker-queue-size))))
(t/is (= 4.0 (gauge-value (collector-instance metrics :http-worker-pool-size))))
(t/is (= 512.0 (gauge-value (collector-instance metrics :http-worker-max-pool-size))))
(t/is (= 0.0
(gauge-value (collector-instance metrics :http-worker-busy-threads))))))
(t/is (= 512.0 (gauge-value (collector-instance metrics :http-worker-max-pool-size))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test: connector metrics
@ -230,28 +223,3 @@
(finally
(px/shutdown-now sampler)
(t/is (px/shutdown? sampler))))))
(t/deftest create-metrics-sampler-reschedules-after-error
;; the docstring promise: an unexpected error on a single sample must
;; not cancel the following runs. The first sample runs immediately
;; and throws; the next one must still be scheduled afterwards.
(let [calls (atom 0)]
(with-redefs [http/sample-http-metrics (fn [_ _ _]
(swap! calls inc)
(throw (ex-info "boom" {})))]
(let [sampler (http/create-metrics-sampler nil (fake-metrics))
queue (.getQueue ^ScheduledThreadPoolExecutor sampler)]
(try
(t/is (loop [i 0]
(cond (pos? @calls) true
(> i 200) false
:else (do (Thread/sleep 10) (recur (inc i)))))
"the first sample must run immediately")
(t/is (loop [i 0]
(cond (= 1 (.size queue)) true
(> i 200) false
:else (do (Thread/sleep 10) (recur (inc i)))))
"the next sample must be scheduled after the error")
(finally
(px/shutdown-now sampler)))))))

66
backend/test/backend_tests/jobs_metrics_test.clj
View File

@ -33,8 +33,8 @@
(def ^:private metric-ids
[:jobs-submitted
:jobs-skipped
:jobs-dispatched
:jobs-completed
:jobs-retries
:jobs-orphaned
:jobs-rescheduled
@ -48,7 +48,6 @@
:jobs-gc-rows
:jobs-gc-timing
:jobs-cron-total
:jobs-requests-total
:jobs-request-timing
:jobs-events-total])
@ -103,7 +102,7 @@
(t/is (some? definition) id)
(t/is (re-find #"^penpot_jobs_" (::mdef/name definition)) id)))
(t/is (= ["name" "queue" "outcome"]
(::mdef/labels (:jobs-completed main/default-metrics))))
(::mdef/labels (:jobs-total-timing main/default-metrics))))
(t/is (= ["status"]
(::mdef/labels (:jobs-backlog main/default-metrics)))))
@ -140,14 +139,37 @@
(jobs/claim cfg job-id (:scheduled-at (jobs/get-job cfg job-id)))
(jobs/complete cfg :job-id job-id :result {:ok true})
(t/is (= 1.0 (counter-value metrics :jobs-submitted ["echo" "default"])))
(t/is (= 1.0 (counter-value metrics :jobs-completed ["echo" "default" "completed"])))))
(t/is (= 1.0 (histogram-count metrics :jobs-total-timing ["echo" "default" "completed"])))))
(t/deftest skip-if-active-records-skipped-metric
(let [metrics (make-metrics)
defs {:echo {::jobs/name :echo
::jobs/schema [:map]
::jobs/handler (fn [_context params] params)
::jobs/decoder identity
::jobs/validator (constantly true)}}
cfg {::jobs/defs defs
::db/pool th/*pool*
::mtx/metrics metrics}
_ (jobs/submit cfg {::jobs/name :echo
::jobs/params {}
::jobs/label "skip-metric"})
skipped (jobs/submit cfg {::jobs/name :echo
::jobs/params {}
::jobs/label "skip-metric"
::jobs/skip-if-active true})]
(t/is (nil? skipped))
(t/is (= 1.0 (counter-value metrics :jobs-skipped ["echo" "default"])))
(t/is (= 1.0 (counter-value metrics :jobs-submitted ["echo" "default"]))
"the withheld submit records no submission")))
(t/deftest lifecycle-helpers-use-labels-as-is
(let [metrics (make-metrics)
cfg (metrics-cfg metrics)]
(jobs-metrics/record-submitted cfg "delete-object" "default")
(jobs-metrics/record-skipped cfg "delete-object" "default")
(jobs-metrics/record-dispatched cfg "delete-object" "default" 2)
(jobs-metrics/record-outcome cfg "delete-object" "default" :completed)
(jobs-metrics/record-total cfg "delete-object" "default" :completed 42)
(jobs-metrics/record-retry cfg "delete-object" "default" :backoff)
(jobs-metrics/record-orphan cfg "webhooks")
(jobs-metrics/record-rescheduled cfg "custom")
@ -157,14 +179,15 @@
(jobs-metrics/record-legacy-execution cfg "delete-object" 42)
(t/is (= 1.0 (counter-value metrics :jobs-submitted ["delete-object" "default"])))
(t/is (= 1.0 (counter-value metrics :jobs-skipped ["delete-object" "default"])))
(t/is (= 2.0 (counter-value metrics :jobs-dispatched ["delete-object" "default"])))
(t/is (= 1.0 (counter-value metrics :jobs-completed ["delete-object" "default" "completed"])))
(t/is (= 1.0 (histogram-count metrics :jobs-total-timing ["delete-object" "default" "completed"])))
(t/is (= 1.0 (counter-value metrics :jobs-retries ["delete-object" "default" "backoff"])))
(t/is (= 1.0 (counter-value metrics :jobs-orphaned ["webhooks"])))
(t/is (= 1.0 (counter-value metrics :jobs-rescheduled ["custom"])))
(t/is (= 3.0 (counter-value metrics :jobs-gc-rows ["expired" "deleted"])))
(t/is (= 1.0 (counter-value metrics :jobs-cron-total ["submitted" "none"])))
(t/is (= 1.0 (counter-value metrics :jobs-requests-total ["replied"])))
(t/is (= 1.0 (histogram-count metrics :jobs-request-timing ["replied"])))
(t/testing "the legacy histogram keeps the raw job name, with no queue"
(t/is (= 1.0 (histogram-count metrics :tasks-timing ["delete-object"]))))
@ -181,15 +204,15 @@
(t/is (= "other" (jobs-metrics/queue-label nil))))
(let [metrics (make-metrics)
cfg (metrics-cfg metrics)]
(jobs-metrics/record-outcome cfg "echo" "unexpected" :unexpected)
(t/is (= 1.0 (counter-value metrics :jobs-completed ["echo" "unexpected" "unexpected"])))
(jobs-metrics/record-total cfg "echo" "unexpected" :unexpected 42)
(t/is (= 1.0 (histogram-count metrics :jobs-total-timing ["echo" "unexpected" "unexpected"])))
(t/testing "a new value is recorded, never folded or dropped"
(jobs-metrics/record-gc-rows cfg :unknown :deleted 1)
(jobs-metrics/record-cron cfg :brand-new :whatever)
(jobs-metrics/record-request cfg :brand-new 5)
(t/is (= 1.0 (counter-value metrics :jobs-gc-rows ["unknown" "deleted"])))
(t/is (= 1.0 (counter-value metrics :jobs-cron-total ["brand-new" "whatever"])))
(t/is (= 1.0 (counter-value metrics :jobs-requests-total ["brand-new"]))))))
(t/is (= 1.0 (histogram-count metrics :jobs-request-timing ["brand-new"]))))))
(t/deftest sampler-is-wired-and-does-not-start-on-read-only
(t/is (contains? main/worker-config :app.jobs.metrics/sampler))
@ -279,7 +302,7 @@
(t/is (= 2 (:cnt (th/db-exec-one! ["SELECT count(*) AS cnt FROM job_event"])))))
(t/testing "the terminal counter followed its own commit, not the caller one"
(t/is (= 1.0 (counter-value metrics :jobs-completed ["echo" "default" "completed"]))))))
(t/is (= 1.0 (histogram-count metrics :jobs-total-timing ["echo" "default" "completed"]))))))
(t/deftest progress-counter-follows-the-report-that-outlives-the-caller
(let [metrics (make-metrics)
@ -298,10 +321,29 @@
(fn [{:keys [::db/conn]}]
(jobs/heartbeat (assoc cfg ::db/conn conn)
:job-id job-id
:progress {:current 1}
:progress {:stage :work}
::jobs/force? true)))
(t/testing "the report is stored and counted, the caller rollback drops neither"
(t/is (= 1 (:cnt (th/db-exec-one! ["SELECT count(*) AS cnt FROM job_event
WHERE job_id = ? AND kind = 'progress'"
job-id]))))
(t/is (= (inc before) (counter-value metrics :jobs-events-total [])))))))
(t/deftest the-binfile-queue-is-labelled-like-any-other
(let [metrics (make-metrics)
defs {:export-binfile {::jobs/name :export-binfile
::jobs/schema [:map]
::jobs/handler (fn [_context params] params)
::jobs/decoder identity
::jobs/validator (constantly true)}}
cfg {::jobs/defs defs
::db/pool th/*pool*
::mtx/metrics metrics}]
(jobs/submit cfg {::jobs/name :export-binfile
::jobs/params {}
::jobs/queue :binfile})
(t/testing "the queue of the job is its label, never other"
(t/is (= 1.0 (counter-value metrics :jobs-submitted ["export-binfile" "binfile"])))
(t/is (= 0.0 (counter-value metrics :jobs-submitted ["export-binfile" "other"]))))))

31
backend/test/backend_tests/jobs_request_test.clj
View File

@ -23,8 +23,6 @@
[integrant.core :as ig])
(:import
io.lettuce.core.api.sync.RedisCommands
io.prometheus.client.Counter
io.prometheus.client.Counter$Child
java.lang.AutoCloseable))
(t/use-fixtures :once th/state-init)
@ -36,8 +34,7 @@
(defn- make-metrics []
(ig/init-key :app.metrics/metrics
{:default (select-keys main/default-metrics
[:jobs-requests-total
:jobs-request-timing])}))
[:jobs-request-timing])}))
(defn- make-pool
([] (make-pool (get th/*system* :app.metrics/metrics)))
@ -131,11 +128,21 @@
;; TESTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- counter-value [metrics id labels]
(let [collector (mtx/get-collector metrics id)
instance (::mdef/instance collector)
child (.labels ^Counter instance (into-array String labels))]
(.get ^Counter$Child child)))
(defn- histogram-count [metrics id labels]
(let [definition (get main/default-metrics id)]
(->> (enumeration-seq
(.metricFamilySamples ^io.prometheus.client.CollectorRegistry
(mtx/get-registry metrics)))
(filter (fn [^io.prometheus.client.Collector$MetricFamilySamples family]
(= (.-name family) (::mdef/name definition))))
(mapcat (fn [^io.prometheus.client.Collector$MetricFamilySamples family]
(.samples family)))
(filter (fn [^io.prometheus.client.Collector$MetricFamilySamples$Sample sample]
(and (str/ends-with? (.-name sample) "_count")
(= labels (vec (.-labelValues sample))))))
(map (fn [^io.prometheus.client.Collector$MetricFamilySamples$Sample sample]
(.-value sample)))
(reduce + 0.0))))
(t/deftest request-pool-keeps-its-own-metrics
(let [metrics-a (make-metrics)
@ -154,14 +161,14 @@
(jobs/request cfg {::jobs/queue :media
::jobs/cmd :process
::jobs/params {}})))
(t/is (= 1.0 (counter-value metrics :jobs-requests-total ["replied"])))
(t/is (= 1.0 (histogram-count metrics :jobs-request-timing ["replied"])))
(t/is (thrown-with-msg? Exception #"timeout waiting for the job reply"
(jobs/request cfg {::jobs/queue :media
::jobs/cmd :process
::jobs/params {}
::jobs/timeout (ct/duration {:millis 100})})))
(t/is (= 1.0 (counter-value metrics :jobs-requests-total ["timeout"])))
(t/is (= 0.0 (counter-value metrics :jobs-requests-total ["sent"])))))
(t/is (= 1.0 (histogram-count metrics :jobs-request-timing ["timeout"])))
(t/is (= 0.0 (histogram-count metrics :jobs-request-timing ["sent"])))))
(t/deftest request-returns-the-ok-reply
(let [pool (make-pool)

205
backend/test/backend_tests/jobs_storage_test.clj Normal file
View File

@ -0,0 +1,205 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns backend-tests.jobs-storage-test
"The storage helpers of the unified jobs substrate: the objects a job
owns through `job.resource_id`."
(:require
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.jobs.storage :as js]
[app.storage :as sto]
[backend-tests.helpers :as th]
[clojure.test :as t]
[cuerdas.core :as str]
[datoteka.fs :as fs]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each (th/serial th/database-reset th/clean-storage))
(defn- get-storage
[]
(assoc (:app.storage/storage th/*system*) ::sto/backend :fs))
(defn- make-cfg
[]
{::db/pool th/*pool*
::sto/storage (get-storage)})
(defn- get-object-row
"The `storage_object` row, deleted rows included."
[id]
(th/db-get :storage-object {:id id} {::db/remove-deleted false}))
(defn- put-artifact
[cfg profile-id content]
(js/put-resource cfg profile-id {:content (sto/content content)
:filename "artifact.penpot"
:mtype "application/zip"}))
(t/deftest put-resource-stores-the-artifact-for-its-owner
(let [cfg (make-cfg)
profile-id (:id (th/create-profile* 1))
result (put-artifact cfg profile-id "penpot-bytes")
object (sto/get-object (get-storage) (:resource-id result))
row (get-object-row (:resource-id result))]
(t/testing "the object lives in the job-resource bucket"
(t/is (= sto/job-resource-bucket (:bucket (meta object)))))
(t/testing "the owner and the content type travel in the metadata"
(t/is (= profile-id (:profile-id (meta object))))
(t/is (= "application/zip" (:content-type (meta object)))))
(t/testing "the object is readable: retention comes from the job row"
(t/is (nil? (:deleted-at row))))
(t/testing "it is touched right away so a crash leaves it reclaimable"
(t/is (some? (:touched-at row))))
(t/testing "the descriptor identifies the artifact"
(t/is (uuid? (:resource-id result)))
(t/is (= 12 (:size result)))
(t/is (= "artifact.penpot" (:filename result)))
(t/is (= "application/zip" (:mtype result)))
(t/is (str/includes? (str (:resource-uri result))
(str (:resource-id result)))))))
(t/deftest put-resource-requires-an-owner
(let [cfg (make-cfg)]
(t/testing "an artifact without an owner is a caller bug"
(t/is (thrown? Throwable
(js/put-resource cfg nil {:content (sto/content "x")
:filename "x.penpot"
:mtype "application/zip"}))))))
(t/deftest load-input-gives-the-handler-a-local-path
(let [cfg (make-cfg)
profile-id (:id (th/create-profile* 1))
staged (put-artifact cfg profile-id "package-bytes")
context {:id (uuid/next)
:resource-id (:resource-id staged)
:profile-id profile-id}
path (js/load-input cfg context)]
(t/is (some? path))
(t/is (= "package-bytes" (slurp (fs/file path))))))
(t/deftest load-input-refuses-an-input-of-another-profile
(let [cfg (make-cfg)
owner (:id (th/create-profile* 1))
stranger (:id (th/create-profile* 2))
staged (put-artifact cfg owner "package-bytes")
context {:id (uuid/next)
:resource-id (:resource-id staged)
:profile-id stranger}]
(t/testing "a handler never reads a package that is not its job's"
(t/is (thrown? Exception (js/load-input cfg context))))))
(t/deftest load-input-refuses-a-missing-or-released-input
(let [cfg (make-cfg)
profile-id (:id (th/create-profile* 1))
staged (put-artifact cfg profile-id "package-bytes")
context {:id (uuid/next)
:resource-id (:resource-id staged)
:profile-id profile-id}]
(t/testing "a job without a resource reference has nothing to load"
(t/is (thrown? Exception (js/load-input cfg (dissoc context :resource-id)))))
(t/testing "an input that was already released cannot be read again"
(t/is (true? (js/release-input cfg context)))
(t/is (thrown? Exception (js/load-input cfg context))))))
(t/deftest release-input-is-idempotent-and-never-throws
(let [cfg (make-cfg)
profile-id (:id (th/create-profile* 1))
staged (put-artifact cfg profile-id "package-bytes")
context {:id (uuid/next)
:resource-id (:resource-id staged)
:profile-id profile-id}]
(t/is (true? (js/release-input cfg context)))
(t/is (some? (:deleted-at (get-object-row (:resource-id staged)))))
(t/testing "releasing twice is a no-op, not an error"
(t/is (false? (js/release-input cfg context))))
(t/testing "releasing a job without a resource is a no-op too"
(t/is (nil? (js/release-input cfg (dissoc context :resource-id)))))))
(t/deftest release-input-clears-the-reference-of-the-job
;; a job that no longer owns its package must not keep pointing at a
;; deleted object: the object and the pointer are dropped together
(let [cfg (make-cfg)
profile-id (:id (th/create-profile* 1))
staged (put-artifact cfg profile-id "package-bytes")
job-id (uuid/next)
context {:id job-id
:resource-id (:resource-id staged)
:profile-id profile-id}]
(th/db-insert! :job {:id job-id
:name "import-binfile"
:tenant (cf/get :tenant)
:queue "binfile"
:params (db/json {})
:priority 100
:max-retries 0
:retry-num 0
:status "running"
:profile-id profile-id
:resource-id (:resource-id staged)
:scheduled-at (ct/now)
:created-at (ct/now)
:modified-at (ct/now)})
(t/is (true? (js/release-input cfg context)))
(t/testing "the object is marked as deleted"
(t/is (some? (:deleted-at (get-object-row (:resource-id staged))))))
(t/testing "and the job row no longer points at it"
(t/is (nil? (:resource-id (th/db-get :job {:id job-id})))))
(t/testing "releasing twice leaves the row alone"
(t/is (false? (js/release-input cfg context)))
(t/is (nil? (:resource-id (th/db-get :job {:id job-id})))))))
(t/deftest release-resource-releases-a-package-no-job-owns
;; the creation path stages the package before the job exists: when the
;; submit fails the package is released with no job id, so the object
;; goes and no row may be touched by it
(let [cfg (make-cfg)
profile-id (:id (th/create-profile* 1))
staged (put-artifact cfg profile-id "package-bytes")
job-id (uuid/next)]
(th/db-insert! :job {:id job-id
:name "import-binfile"
:tenant (cf/get :tenant)
:queue "binfile"
:params (db/json {})
:priority 100
:max-retries 0
:retry-num 0
:status "running"
:profile-id profile-id
:resource-id nil
:scheduled-at (ct/now)
:created-at (ct/now)
:modified-at (ct/now)})
(let [before (th/db-get :job {:id job-id})]
(t/is (true? (js/release-resource cfg (:resource-id staged))))
(t/testing "the object is marked as deleted"
(t/is (some? (:deleted-at (get-object-row (:resource-id staged))))))
(t/testing "and the unrelated job row is exactly as it was"
(t/is (= before (th/db-get :job {:id job-id})))))))

425
backend/test/backend_tests/jobs_test.clj
View File

@ -27,6 +27,11 @@
(t/use-fixtures :each test-fixture)
(defn- raised
"Run `f` and answer with the exception it raised, or nil when it did not."
[f]
(try (f) nil (catch Throwable cause cause)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; JOB-DEF (plain handler + precompiled init-key)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -39,7 +44,8 @@
[cfg params]
(when (::jobs/job-id cfg)
(jobs/heartbeat cfg)
(jobs/heartbeat cfg :progress {:current 1 :stage "half"}))
(jobs/heartbeat cfg :progress {:stage :half
:counters {:work {:current 1 :total 2}}}))
params)
(def schema:echo-params
@ -101,7 +107,24 @@
WHERE job_id = ? AND kind = 'progress'
ORDER BY created_at ASC, id ASC"
job-id])
(mapv #(db/decode-json-pgobject (:payload %)))))
(mapv #(jobs/decode-progress (:payload %)))))
(defn- get-events
"Every event of a job, in insertion order."
[job-id]
(->> (th/db-exec! ["SELECT kind, payload FROM job_event
WHERE job_id = ? ORDER BY id ASC" job-id])
(mapv (fn [{:keys [kind payload]}]
{:kind kind :payload (db/decode-json-pgobject payload)}))))
(defn- get-outcomes
"Outcomes of the end events of a job, oldest first."
[job-id]
(mapv (comp :outcome :payload) (filter #(= "end" (:kind %)) (get-events job-id))))
(defn- get-kinds
[job-id]
(mapv :kind (get-events job-id)))
(defn- fake-msgbus
"A minimal msgbus that records every publication on the atom."
@ -159,48 +182,101 @@
(t/testing "no job row was created by the rejected submits"
(t/is (= 0 (:cnt (th/db-exec-one! ["SELECT count(*) AS cnt FROM job"])))))))
(t/deftest submit-persists-an-expiry-date
(let [cfg (make-cfg (get-job-defs))
expires-at (ct/plus (ct/now) (ct/duration {:days 7}))]
(t/testing "an explicit expiry is persisted as the retention of the job"
(let [job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)
::jobs/expires-at expires-at})
row (jobs/get-job cfg job-id)]
(t/is (= (inst-ms expires-at) (inst-ms (:expires-at row))))))
(t/testing "without the option the column stays nil, as before"
(let [job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})
row (jobs/get-job cfg job-id)]
(t/is (nil? (:expires-at row)))))))
(t/deftest submit-rejects-an-invalid-expiry-date
(let [cfg (make-cfg (get-job-defs))]
(t/testing "a value that is not an instant is rejected before the insert"
(t/is (thrown? Exception
(jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)
::jobs/expires-at "not-an-instant"}))))
(t/testing "no job row was created by the rejected submit"
(t/is (= 0 (:cnt (th/db-exec-one! ["SELECT count(*) AS cnt FROM job"])))))))
(t/deftest progress-report-validates-its-payload
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(t/testing "current is mandatory"
(t/is (thrown? Exception
(jobs/heartbeat cfg :job-id job-id :progress {:total 10}))))
(t/testing "unknown keys are rejected"
(t/testing "stage is mandatory"
(t/is (thrown? Exception
(jobs/heartbeat cfg :job-id job-id
:progress {:current 1 :step 1}))))
:progress {:counters {:work {:current 1}}}))))
(t/testing "current must not be negative"
(t/testing "stage must be a keyword, not a label"
(t/is (thrown? Exception
(jobs/heartbeat cfg :job-id job-id
:progress {:stage "work"}))))
(t/testing "unknown keys are rejected, at the top and inside a counter"
(t/is (thrown? Exception
(jobs/heartbeat cfg :job-id job-id
:progress {:stage :work :step 1})))
(t/is (thrown? Exception
(jobs/heartbeat cfg :job-id job-id
:progress {:stage :work
:counters {:work {:current 1
:step 1}}}))))
(t/testing "a counter current must not be negative"
(t/is (thrown-with-msg? Exception #"negative"
(jobs/heartbeat cfg :job-id job-id
:progress {:current -1}))))
:progress {:stage :work
:counters {:work {:current -1}}}))))
(t/testing "total must be positive"
(t/testing "a counter total must be positive"
(t/is (thrown-with-msg? Exception #"positive"
(jobs/heartbeat cfg :job-id job-id
:progress {:current 0 :total 0}))))
:progress {:stage :work
:counters {:work {:current 0
:total 0}}}))))
(t/testing "current must not be greater than total"
(t/testing "a counter current must not be greater than its total"
(t/is (thrown-with-msg? Exception #"not lower than current"
(jobs/heartbeat cfg :job-id job-id
:progress {:current 5 :total 4}))))
:progress {:stage :work
:counters {:work {:current 5
:total 4}}}))))
(t/testing "stage is limited to 250 characters"
(t/is (thrown-with-msg? Exception #"250"
(t/testing "keys are limited to a name and not a payload"
(t/is (thrown-with-msg? Exception #"64"
(jobs/heartbeat cfg :job-id job-id
:progress {:current 1
:stage (apply str (repeat 251 "x"))})))
:progress {:stage (keyword (apply str (repeat 65 "x")))}))))
(t/testing "a milestone without counters is accepted"
(t/is (= 2 (jobs/heartbeat cfg :job-id job-id :progress {:stage :relations}))))
(t/testing "a milestone with counters is accepted and stored as it is"
(swap! jobs/progresses dissoc job-id)
(swap! jobs/heartbeats dissoc job-id)
(t/is (= 2 (jobs/heartbeat cfg :job-id job-id
:progress {:current 1
:stage (apply str (repeat 250 "x"))})))
(t/is (= [{:current 1 :stage (apply str (repeat 250 "x"))}]
:progress {:stage :pages
:counters {:files {:current 2 :total 5}
:pages {:current 3 :total 8}}})))
(t/is (= [{:stage :relations}
{:stage :pages
:counters {:files {:current 2 :total 5}
:pages {:current 3 :total 8}}}]
(get-progresss job-id))))
(t/testing "a rejected report never reaches the durable log"
(t/is (= 1 (count (get-progresss job-id)))))))
(t/is (= 2 (count (get-progresss job-id)))))))
(t/deftest progress-event-publishes-msgbus-for-profile-jobs
(let [cfg (make-cfg (get-job-defs))
@ -211,7 +287,8 @@
::jobs/params (make-params)
::jobs/profile-id profile-id})]
(t/is (pos? (jobs/heartbeat job-cfg :job-id job-id
:progress {:current 3 :total 7})))
:progress {:stage :pages
:counters {:files {:current 3 :total 7}}})))
(t/testing "the event is published on the topic of the job profile"
(t/is (= 1 (count @messages)))
(let [{:keys [topic message]} (first @messages)]
@ -220,7 +297,9 @@
(t/is (= job-id (:job-id message)))
(t/is (= profile-id (:profile-id message)))
(t/is (= "progress" (:kind message)))
(t/is (= {:current 3 :total 7} (:payload message)))
(t/is (= {:stage :pages
:counters {:files {:current 3 :total 7}}}
(:payload message)))
(t/is (some? (:event-id message)))
(t/is (some? (:created-at message)))))))
@ -230,7 +309,7 @@
job-cfg (assoc cfg ::mbus/msgbus (fake-msgbus messages))
job-id (jobs/submit job-cfg {::jobs/name :echo
::jobs/params (make-params)})]
(t/is (pos? (jobs/heartbeat job-cfg :job-id job-id :progress {:current 1})))
(t/is (pos? (jobs/heartbeat job-cfg :job-id job-id :progress {:stage :work})))
(t/testing "the event is stored but nothing is published"
(t/is (= 1 (count (get-progresss job-id))))
(t/is (= [] @messages)))))
@ -245,7 +324,7 @@
(t/is (thrown-with-msg? Exception #"require ::mbus/msgbus"
(jobs/heartbeat cfg
:job-id job-id
:progress {:current 1}
:progress {:stage :work}
::jobs/force? true)))
(t/is (= [] (get-progresss job-id))
"the event must not be stored without its notification"))
@ -254,7 +333,7 @@
(th/db-update! :job {:modified-at (ct/in-past {:minutes 5})} {:id job-id})
(swap! jobs/heartbeats dissoc job-id)
(t/is (= 1 (jobs/heartbeat cfg :job-id job-id
:progress {:current 1})))
:progress {:stage :work})))
(t/is (= [] (get-progresss job-id))))))
(t/deftest submit-validates-params-with-job-schema
@ -428,6 +507,69 @@
AND tenant = ?"
label (cf/get :tenant)])))))))
(t/deftest submit-skip-if-active-skips-live-jobs
(doseq [status ["new" "scheduled" "running" "retry"]]
(t/testing (str "live status " status)
(let [cfg (make-cfg (get-job-defs))
params (make-params)
label (str "skip-active-" status)
id1 (jobs/submit cfg {::jobs/name :echo
::jobs/params params
::jobs/label label})
_ (th/db-update! :job {:status status} {:id id1})
id2 (jobs/submit cfg {::jobs/name :echo
::jobs/params params
::jobs/label label
::jobs/skip-if-active true})]
(t/is (nil? id2))
(t/testing "no row deleted, none inserted"
(t/is (some? (jobs/get-job cfg id1)))
(t/is (= 1 (:cnt (th/db-exec-one! ["SELECT count(*) AS cnt FROM job
WHERE label = ?" label])))))))))
(t/deftest submit-skip-if-active-inserts-past-terminal-jobs
(doseq [status ["completed" "failed" "cancelled" "aborted"]]
(t/testing (str "terminal status " status)
(let [cfg (make-cfg (get-job-defs))
params (make-params)
label (str "skip-terminal-" status)
id1 (jobs/submit cfg {::jobs/name :echo
::jobs/params params
::jobs/label label})
_ (th/db-update! :job {:status status} {:id id1})
id2 (jobs/submit cfg {::jobs/name :echo
::jobs/params params
::jobs/label label
::jobs/skip-if-active true})]
(t/is (uuid? id2))
(t/is (= 2 (:cnt (th/db-exec-one! ["SELECT count(*) AS cnt FROM job
WHERE label = ?" label]))))))))
(t/deftest submit-skip-if-active-requires-an-explicit-label
(let [cfg (make-cfg (get-job-defs))
params (make-params)]
(t/is (thrown-with-msg? Exception #"skip-if-active requires"
(jobs/submit cfg {::jobs/name :echo
::jobs/params params
::jobs/skip-if-active true})))
(t/is (thrown-with-msg? Exception #"skip-if-active requires"
(jobs/submit cfg {::jobs/name :echo
::jobs/params params
::jobs/label " "
::jobs/skip-if-active true})))))
(t/deftest submit-skip-if-active-inserts-when-nothing-is-live
(let [cfg (make-cfg (get-job-defs))
params (make-params)
label "skip-idle-label"
id1 (jobs/submit cfg {::jobs/name :echo
::jobs/params params
::jobs/label label
::jobs/skip-if-active true})]
(t/is (uuid? id1))
(t/is (= 1 (:cnt (th/db-exec-one! ["SELECT count(*) AS cnt FROM job
WHERE label = ?" label]))))))
(t/deftest submit-dedupe-rolls-back-on-insert-failure
(let [cfg (make-cfg (get-job-defs))
params (make-params)
@ -530,34 +672,67 @@
(t/is (= (inst-ms (:modified-at row1))
(inst-ms (:modified-at row2))))))))
(t/deftest heartbeat-skips-terminal-states
(t/deftest heartbeat-interrupts-on-terminal-states
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(t/testing "terminal states are never touched by heartbeat"
(t/testing "a terminal state raises the interrupt instead of touching the row"
(th/db-update! :job {:status "completed"
:modified-at (ct/in-past {:days 10})}
{:id job-id})
(swap! @#'jobs/heartbeats dissoc job-id)
(let [before (jobs/get-job cfg job-id)]
(jobs/heartbeat cfg :job-id job-id)
(let [before (jobs/get-job cfg job-id)
cause (raised #(jobs/heartbeat cfg :job-id job-id))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (= :job-interrupted (th/ex-code cause)))
(t/is (= job-id (:job-id (ex-data cause))))
(t/is (= "completed" (:status (ex-data cause))))
(t/is (= (inst-ms (:modified-at before))
(inst-ms (:modified-at (jobs/get-job cfg job-id)))))))))
(t/deftest progress-events-respect-throttle-and-skip-terminal-states
(t/deftest heartbeat-interrupts-when-the-row-is-gone
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(th/db-force-delete :job {:id job-id})
(let [cause (raised #(jobs/heartbeat cfg :job-id job-id))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (= :job-interrupted (th/ex-code cause)))
(t/is (= "gone" (:status (ex-data cause)))))))
(t/deftest a-transient-progress-failure-is-not-an-interrupt
"The handler path logs and ignores a progress insert that fails, but an
interrupt must not be swallowed with it: only an interrupt means the job
is gone."
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(swap! jobs/progresses dissoc job-id)
(swap! jobs/heartbeats dissoc job-id)
;; the insert is the boundary that fails: the job itself is active, so
;; the beat answers with the touch it did write instead of raising
(with-redefs-fn {#'jobs/report-progress (fn [& _] (throw (ex-info "boom" {})))}
#(t/is (= 1 (jobs/heartbeat cfg :job-id job-id :progress {:stage :work}))))
(t/is (= [] (get-progresss job-id)))))
(t/deftest progress-events-respect-throttle-and-interrupt-on-terminal-states
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(t/testing "first progress report appends a progress event"
(t/is (= 2 (jobs/heartbeat cfg :job-id job-id
:progress {:current 1 :total 10})))
(t/is (= [{:current 1 :total 10}] (get-progresss job-id))))
:progress {:stage :pages
:counters {:pages {:current 1 :total 10}}})))
(t/is (= [{:stage :pages :counters {:pages {:current 1 :total 10}}}]
(get-progresss job-id))))
(t/testing "immediate second progress report is throttled"
(t/is (= 0 (jobs/heartbeat cfg :job-id job-id
:progress {:current 2 :total 10})))
(t/is (= [{:current 1 :total 10}] (get-progresss job-id)))
:progress {:stage :pages
:counters {:pages {:current 2 :total 10}}})))
(t/is (= [{:stage :pages :counters {:pages {:current 1 :total 10}}}]
(get-progresss job-id)))
(t/testing "after the throttle window elapses it appends again"
(swap! @#'jobs/progresses
@ -565,9 +740,11 @@
(update-in m [job-id]
#(ct/minus %
(ct/duration {:seconds 2})))))
(jobs/heartbeat cfg :job-id job-id :progress {:current 3 :total 10})
(t/is (= [{:current 1 :total 10}
{:current 3 :total 10}]
(jobs/heartbeat cfg :job-id job-id
:progress {:stage :pages
:counters {:pages {:current 3 :total 10}}})
(t/is (= [{:stage :pages :counters {:pages {:current 1 :total 10}}}
{:stage :pages :counters {:pages {:current 3 :total 10}}}]
(get-progresss job-id))))))
(let [cfg (make-cfg (get-job-defs))
@ -576,9 +753,11 @@
(t/testing "terminal states never get a progress event"
(th/db-update! :job {:status "completed"} {:id job-id})
(swap! @#'jobs/progresses dissoc job-id)
(t/is (= 0 (jobs/heartbeat cfg :job-id job-id
:progress {:current 9})))
(t/is (= [] (get-progresss job-id))))))
(swap! @#'jobs/heartbeats dissoc job-id)
(let [cause (raised #(jobs/heartbeat cfg :job-id job-id
:progress {:stage :work}))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (= [] (get-progresss job-id)))))))
(t/deftest throttle-prune-removes-stale-entries-keeps-fresh
"When the throttle map exceeds prune-threshold, stale entries (older than
@ -609,7 +788,7 @@
(t/is (contains? state job-id-2) "fresh entry kept")
(t/is (contains? state job-id-3) "new entry added"))))))
(t/deftest cancel-skips-running-and-terminal-jobs
(t/deftest cancel-skips-terminal-jobs
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
@ -617,27 +796,30 @@
(t/testing "pending job can be cancelled"
(t/is (= 1 (jobs/cancel cfg job-id)))
(t/is (= "cancelled" (:status (jobs/get-job cfg job-id))))
(t/is (= ["cancelled"] (get-outcomes job-id)))
(t/testing "already cancelled job is not affected again"
(t/is (zero? (jobs/cancel cfg job-id))))))
(t/is (zero? (jobs/cancel cfg job-id)))
(t/is (= ["cancelled"] (get-outcomes job-id))))))
(doseq [status ["completed" "failed"]]
(t/testing (str status " job cannot be cancelled")
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(th/db-update! :job {:status status} {:id job-id})
(t/is (zero? (jobs/cancel cfg job-id)))
(t/is (= status (:status (jobs/get-job cfg job-id))))
(t/is (= [] (get-outcomes job-id)))))))
(let [cfg (make-cfg (get-job-defs))
job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(t/testing "running job cannot be cancelled"
(th/db-update! :job {:status "running"} {:id job-id})
(t/is (zero? (jobs/cancel cfg job-id)))
(t/is (= "running" (:status (jobs/get-job cfg job-id)))))))
(t/deftest cancel-affects-scheduled-and-retry-jobs
(t/deftest cancel-affects-pending-and-running-jobs
(let [cfg (make-cfg (get-job-defs))]
(doseq [status ["scheduled" "retry"]]
(doseq [status ["scheduled" "retry" "running"]]
(t/testing (str status " job can be cancelled")
(let [job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(th/db-update! :job {:status status} {:id job-id})
(t/is (= 1 (jobs/cancel cfg job-id)))
(t/is (= "cancelled" (:status (jobs/get-job cfg job-id)))))))))
(t/is (= "cancelled" (:status (jobs/get-job cfg job-id))))
(t/is (= ["cancelled"] (get-outcomes job-id))))))))
(t/deftest get-user-status-maps-internal-statuses
(t/are [status expected] (= expected (jobs/get-user-status status))
@ -673,6 +855,32 @@
::jobs/handler (fn [_context params]
params)}}})))))
(t/deftest job-def-carries-optional-family-and-resource-role
(let [job-def {::jobs/name :echo
::jobs/family :export
::jobs/resource-role :output
::jobs/schema schema:echo-params
::jobs/handler (fn [_context params] params)
::jobs/decoder (sm/decoder schema:echo-params sm/json-transformer)
::jobs/validator (sm/validator schema:echo-params)}]
(t/testing "the metadata is accepted and readable from the registry"
(let [defs (-> (ig/init {::jobs/defs {:echo job-def}})
(get ::jobs/defs))
echo (jobs/get-job-def defs :echo)]
(t/is (= :export (::jobs/family echo)))
(t/is (= :output (::jobs/resource-role echo)))))
(t/testing "a family is a keyword, not a free string"
(t/is (thrown? Exception
(ig/init {::jobs/defs {:echo (assoc job-def
::jobs/family "export")}}))))
(t/testing "a resource role is a keyword too"
(t/is (thrown? Exception
(ig/init {::jobs/defs {:echo (assoc job-def
::jobs/resource-role "output")}}))))))
(t/deftest generic-schema-round-trip-preserves-type-sensitive-fields
"For each registered job-def, verify that type-sensitive fields (uuids, insts)
survive the JSON round-trip (db/json → decode). This catches the F2 class of
@ -742,25 +950,28 @@
(t/testing "progress reporting is a no-op when *job-id* is nil"
(binding [jobs/*job-id* nil]
(t/is (nil? (jobs/heartbeat cfg :progress {:current 1}))))
(t/is (nil? (jobs/heartbeat cfg :progress {:stage :work}))))
(t/is (= [] (get-progresss job-id))
"no progress event should be stored"))))
(t/deftest progress-noop-on-terminal-states
(t/deftest progress-interrupts-on-terminal-states
"A progress report never stores an event when the job is already in a
terminal state (completed, failed, cancelled, aborted): the row is locked and
checked before the insert, so a report can never race a terminal
transition."
transition, and the beat raises the interrupt instead."
(let [cfg (make-cfg (get-job-defs))]
(doseq [status ["completed" "failed" "cancelled" "aborted"]]
(t/testing (str "progress is a no-op on " status " status")
(t/testing (str "progress interrupts on " status " status")
(let [job-id (jobs/submit cfg {::jobs/name :echo
::jobs/params (make-params)})]
(th/db-update! :job {:status status} {:id job-id})
;; reset the throttle so should-write? would allow the write
;; reset the throttles so should-write? would allow the writes
(swap! jobs/progresses dissoc job-id)
(swap! jobs/heartbeats dissoc job-id)
(binding [jobs/*job-id* job-id]
(t/is (= 0 (jobs/heartbeat cfg :progress {:current 1}))))
(let [cause (raised #(jobs/heartbeat cfg :progress {:stage :work}))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (= status (:status (ex-data cause))))))
(t/is (= [] (get-progresss job-id))))))))
(t/deftest defs-halt-clears-module-registry
@ -797,8 +1008,8 @@
(fn [{:keys [::db/conn]}]
(jobs/heartbeat (assoc cfg ::db/conn conn)
:job-id job-id
:progress {:current 1})))
(t/is (= [{:current 1}] (get-progresss job-id)))))
:progress {:stage :work})))
(t/is (= [{:stage :work}] (get-progresss job-id)))))
(t/deftest progress-notification-survives-a-rolled-back-caller
(let [cfg (make-cfg (get-job-defs))
@ -814,9 +1025,9 @@
(fn [{:keys [::db/conn]}]
(jobs/heartbeat (assoc job-cfg ::db/conn conn)
:job-id job-id
:progress {:current 1})))
:progress {:stage :work})))
(t/testing "the event is stored"
(t/is (= [{:current 1}] (get-progresss job-id))))
(t/is (= [{:stage :work}] (get-progresss job-id))))
(t/testing "and the notification went out with its own commit"
(t/is (= 1 (count @messages)))
(t/is (= "progress" (:kind (:message (first @messages))))))))
@ -829,7 +1040,7 @@
(t/is (thrown? Exception
(jobs/heartbeat th/*pool*
:job-id job-id
:progress {:current 1}))))))
:progress {:stage :work}))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -844,6 +1055,7 @@
:tenant (cf/get :tenant)
:queue "default"
:label nil
:profile-id nil
:resource-id nil
:retry-num 0
:max-retries 3}
@ -851,7 +1063,7 @@
(t/deftest make-context-selects-exactly-the-agreed-keys
(let [context (jobs/make-context (mk-row {}))]
(t/is (= #{:id :name :label :resource-id} (set (keys context))))
(t/is (= #{:id :name :label :resource-id :profile-id} (set (keys context))))
(t/testing "the queue is a routing detail of the dispatcher, not context"
(t/is (not (contains? context :queue))))
(t/testing "nor is the tenant that owns the queue"
@ -880,11 +1092,23 @@
(t/is (= resource-id
(:resource-id (jobs/make-context (mk-row {:resource-id resource-id}))))))))
(t/deftest make-context-carries-the-job-owner
(t/testing "the key exists even when the job has no owner"
(let [context (jobs/make-context (mk-row {}))]
(t/is (contains? context :profile-id))
(t/is (nil? (:profile-id context)))))
(t/testing "the owner of a user job is carried as is"
(let [profile-id (uuid/next)]
(t/is (= profile-id
(:profile-id (jobs/make-context (mk-row {:profile-id profile-id}))))))))
(t/deftest make-context-rejects-invalid-rows
(t/testing "a missing id is rejected"
(t/is (thrown? Exception (jobs/make-context (mk-row {:id nil})))))
(t/testing "a missing name is rejected"
(t/is (thrown? Exception (jobs/make-context (mk-row {:name nil})))))
(t/testing "a non uuid owner is rejected"
(t/is (thrown? Exception (jobs/make-context (mk-row {:profile-id "nope"})))))
(t/testing "a non uuid resource reference is rejected"
(t/is (thrown? Exception (jobs/make-context (mk-row {:resource-id "nope"}))))))
@ -955,29 +1179,13 @@
"a job-id without a context still delivers a nil context")
(t/testing "the job-id is what makes the durable writes reach the row"
(t/is (pos? (jobs/heartbeat cfg :job-id job-id
:progress {:current 1})))
(t/is (= [{:current 1}] (get-progresss job-id))))))
:progress {:stage :work})))
(t/is (= [{:stage :work}] (get-progresss job-id))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LIFECYCLE EVENTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- get-events
"Every event of a job, in insertion order."
[job-id]
(->> (th/db-exec! ["SELECT kind, payload FROM job_event
WHERE job_id = ? ORDER BY id ASC" job-id])
(mapv (fn [{:keys [kind payload]}]
{:kind kind :payload (db/decode-json-pgobject payload)}))))
(defn- get-kinds
[job-id]
(mapv :kind (get-events job-id)))
(defn- get-outcomes
[job-id]
(mapv (comp :outcome :payload) (filter #(= "end" (:kind %)) (get-events job-id))))
(defn- mk-running
"A job already claimed by a worker, ready for a terminal transition."
[cfg]
@ -1269,6 +1477,23 @@
(t/is (nil? (:resource-id row)))
(t/is (= "running" (:status row))))))))
(t/deftest insert-event-requires-a-transaction
;; The event insert is only valid inside the transaction that owns the
;; job row: outside one the assert fires instead of writing. Like every
;; assert-based guard, this only holds with the backend asserts flag.
(t/is (true? *assert*)
"run the suite with PENPOT_FLAGS=\"enable-backend-asserts\"")
(let [cfg (make-cfg (get-job-defs))
job-id (mk-running cfg)]
(t/testing "a pool cfg with no transaction raises"
(t/is (thrown? AssertionError
(@#'jobs/insert-event cfg job-id "progress" {:stage :half}))))
(t/testing "a bare connection with no transaction raises too"
(db/run! cfg (fn [conn-cfg]
(t/is (thrown? AssertionError
(@#'jobs/insert-event conn-cfg job-id "progress"
{:stage :half}))))))))
(t/deftest complete-associates-a-resource-id-once
(let [cfg (make-cfg (get-job-defs))
resource-id (uuid/next)]
@ -1393,10 +1618,17 @@
(let [cfg (make-cfg (get-job-defs))
job-id (mk-running cfg)]
(t/testing "a progress report and a completion of the same job, at once"
(let [[_writes completed] (race #(jobs/heartbeat cfg :job-id job-id
:progress {:current 1}
::jobs/force? true)
#(jobs/complete cfg :job-id job-id :result {:v 1}))]
;; the report either lands before the end or loses the race and gets
;; the interrupt: a beat on a job that is no longer active raises
(let [report (fn []
(if (some? (raised #(jobs/heartbeat cfg :job-id job-id
:progress {:stage :work}
::jobs/force? true)))
:interrupted
:reported))
[outcome completed] (race report #(jobs/complete cfg :job-id job-id :result {:v 1}))]
(t/is (contains? #{:interrupted :reported} outcome)
"the report lands or gets the interrupt, never anything else")
(t/is (= 1 completed) "the completion always wins, it owns the row")
(t/testing "the report either lost the race or was stored before the end"
(let [kinds (get-kinds job-id)]
@ -1406,10 +1638,11 @@
(t/is (<= 2 (count kinds) 3)
"at most the one report that made it in before the end"))))
(t/testing "a job that ended is not resurrected by a late report"
(let [before (get-kinds job-id)]
(t/is (zero? (jobs/heartbeat cfg :job-id job-id
:progress {:current 2}
::jobs/force? true)))
(let [before (get-kinds job-id)
cause (raised #(jobs/heartbeat cfg :job-id job-id
:progress {:stage :work}
::jobs/force? true))]
(t/is (= :interrupt (th/ex-type cause)))
(t/is (= before (get-kinds job-id)) "the late report stored nothing"))))))
(t/deftest progress-event-reaches-the-cfg-of-its-own-callback
@ -1426,9 +1659,9 @@
::jobs/params (make-params)
::jobs/profile-id profile-id})]
(t/is (pos? (jobs/heartbeat job-cfg :job-id job-id
:progress {:current 1})))
:progress {:stage :work})))
(t/testing "the event was stored"
(t/is (= [{:current 1}] (get-progresss job-id))))
(t/is (= [{:stage :work}] (get-progresss job-id))))
(t/testing "and the msgbus on that cfg was reachable from the callback"
(t/is (= 1 (count @messages)))
(t/is (= "progress" (:kind (:message (first @messages))))))))

147
backend/test/backend_tests/loggers_audit_archive_task_test.clj
View File

@ -26,18 +26,25 @@
(def ^:private archive-uri "http://nexus.example/archive")
(defn- insert-audit-row!
[profile-id name]
(th/db-insert! :audit-log
{:id (uuid/next)
:name name
:type "action"
:source "backend"
:profile-id profile-id
:ip-addr (db/inet "127.0.0.1")
:props (db/tjson {:team-id (uuid/next)})
:context (db/tjson {})
:tracked-at (ct/now)
:created-at (ct/now)}))
([profile-id name]
(insert-audit-row! profile-id name {:team-id (uuid/next)}))
([profile-id name props]
(th/db-insert! :audit-log
{:id (uuid/next)
:name name
:type "action"
:source "backend"
:profile-id profile-id
:ip-addr (db/inet "127.0.0.1")
:props (db/tjson props)
:context (db/tjson {})
:tracked-at (ct/now)
:created-at (ct/now)})))
(defn- nitrate-event-props
[nitrate-mock]
(let [[_ _ params] (:call-args @nitrate-mock)]
(:props (first (:events params)))))
(t/deftest archive-events-sends-to-nitrate-then-nexus
;; Create profile before enabling :admin-console — system nitrate
@ -76,14 +83,16 @@
(with-mocks [nitrate-mock {:target 'app.nitrate/call :return nil}
http-mock {:target 'app.http.client/req :return {:status 204}}]
(insert-audit-row! (:id prof) "create-project")
(insert-audit-row! (:id prof) "create-organization-attribute")
(insert-audit-row! (:id prof) "unrelated-event")
(th/run-task! :audit-log-archive {:uri archive-uri})
(t/is (:called? @nitrate-mock))
(t/is (:called? @http-mock))
(let [[_ _ params] (:call-args @nitrate-mock)]
(t/is (= ["create-project"] (mapv :name (:events params)))))
(t/is (= #{"create-project" "create-organization-attribute"}
(into #{} (map :name) (:events params)))))
(let [rows (th/db-exec! ["select * from audit_log where archived_at is not null"])]
(t/is (= 2 (count rows))))))))
(t/is (= 3 (count rows))))))))
(t/deftest archive-events-skips-nitrate-when-no-matching-names
(let [prof (th/create-profile* 1 {:is-active true})]
@ -229,3 +238,113 @@
(catch Throwable cause
cause)))]
(t/is (= :task-not-configured (:code data))))))
(t/deftest archive-events-enriches-team-name-and-emails
(let [actor (th/create-profile* 1 {:is-active true})
member (th/create-profile* 2 {:is-active true})
team (th/create-team* 1 {:profile-id (:id actor)})]
(with-redefs [cf/flags #{:admin-console}]
(with-mocks [nitrate-mock {:target 'app.nitrate/call :return nil}]
(insert-audit-row! (:id actor) "create-project"
{:team-id (:id team)
:profile-id (:id actor)
:user-id (:id member)
:member-id (:id member)
;; Producers store this as a string UUID.
:user-who-send-invitation (str (:id actor))})
(th/run-task! :audit-log-archive {})
(t/is (:called? @nitrate-mock))
(let [props (nitrate-event-props nitrate-mock)]
(t/is (= (:name team) (:team-name props)))
(t/is (= (:email actor) (:profile-email props)))
(t/is (= (:email member) (:user-email props)))
(t/is (= (:email member) (:member-email props)))
(t/is (= (:email actor) (:user-who-send-invitation-email props))))
(let [rows (th/db-exec! ["select * from audit_log where archived_at is not null"])]
(t/is (= 1 (count rows))))))))
(t/deftest archive-events-enriches-soft-deleted-team-and-profile
(let [actor (th/create-profile* 1 {:is-active true})
other (th/create-profile* 2 {:is-active true})
team (th/create-team* 1 {:profile-id (:id actor)})]
(th/db-update! :team {:deleted-at (ct/now)} {:id (:id team)})
(th/db-update! :profile {:deleted-at (ct/now)} {:id (:id other)})
(with-redefs [cf/flags #{:admin-console}]
(with-mocks [nitrate-mock {:target 'app.nitrate/call :return nil}]
(insert-audit-row! (:id actor) "create-project"
{:team-id (:id team)
:profile-id (:id other)})
(th/run-task! :audit-log-archive {})
(let [props (nitrate-event-props nitrate-mock)]
(t/is (= (:name team) (:team-name props)))
(t/is (= (:email other) (:profile-email props))))
(let [rows (th/db-exec! ["select * from audit_log where archived_at is not null"])]
(t/is (= 1 (count rows))))))))
(t/deftest archive-events-does-not-overwrite-existing-enrich-props
(let [actor (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id actor)})]
(with-redefs [cf/flags #{:admin-console}]
(with-mocks [nitrate-mock {:target 'app.nitrate/call :return nil}]
(insert-audit-row! (:id actor) "create-project"
{:team-id (:id team)
:team-name "already-set-name"
:profile-id (:id actor)
:profile-email "already-set@example.com"
:user-id (:id actor)
:user-email "already-user@example.com"
:member-id (:id actor)
:member-email "already-member@example.com"
:user-who-send-invitation (str (:id actor))
:user-who-send-invitation-email "already-inviter@example.com"})
(th/run-task! :audit-log-archive {})
(let [props (nitrate-event-props nitrate-mock)]
(t/is (= "already-set-name" (:team-name props)))
(t/is (= "already-set@example.com" (:profile-email props)))
(t/is (= "already-user@example.com" (:user-email props)))
(t/is (= "already-member@example.com" (:member-email props)))
(t/is (= "already-inviter@example.com"
(:user-who-send-invitation-email props))))))))
(t/deftest archive-events-enrich-skips-missing-and-non-uuid-ids
(let [actor (th/create-profile* 1 {:is-active true})]
(with-redefs [cf/flags #{:admin-console}]
(with-mocks [nitrate-mock {:target 'app.nitrate/call :return nil}]
(insert-audit-row! (:id actor) "create-project"
{:team-id (uuid/next)
:profile-id (uuid/next)
:user-id "not-a-uuid"
:member-id 42})
(th/run-task! :audit-log-archive {})
(t/is (:called? @nitrate-mock))
(let [props (nitrate-event-props nitrate-mock)]
(t/is (nil? (:team-name props)))
(t/is (nil? (:profile-email props)))
(t/is (nil? (:user-email props)))
(t/is (nil? (:member-email props)))
(t/is (= "not-a-uuid" (:user-id props)))
(t/is (= 42 (:member-id props))))
(let [rows (th/db-exec! ["select * from audit_log where archived_at is not null"])]
(t/is (= 1 (count rows))))))))
(t/deftest archive-events-forwards-export-job-not-legacy-export
(let [actor (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id actor)})]
(with-redefs [cf/flags #{:admin-console}]
(with-mocks [nitrate-mock {:target 'app.nitrate/call :return nil}]
(insert-audit-row! (:id actor) "create-export-binfile-job"
{:team-id (:id team)
:job-id (uuid/next)
:files 1
:export-type "detach-libraries"})
(insert-audit-row! (:id actor) "export-binfile"
{:file-id (uuid/next)})
(th/run-task! :audit-log-archive {})
(let [[_ _ params] (:call-args @nitrate-mock)
events (:events params)
props (:props (first events))]
(t/is (= ["create-export-binfile-job"] (mapv :name events)))
(t/is (= (:id team) (:team-id props)))
(t/is (= (:name team) (:team-name props))))
(let [rows (th/db-exec! ["select * from audit_log where archived_at is not null"])]
(t/is (= 2 (count rows))))))))

66
backend/test/backend_tests/media_test.clj
View File

@ -137,6 +137,72 @@
(t/is (not (clojure.string/includes? result "onmouseover")))
(t/is (clojure.string/includes? result "<rect")))))
(t/deftest sanitize-svg-namespace-prefixed-script
(t/testing "sanitize-svg removes script tags written with a namespace prefix bound to the SVG namespace"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:x=\"http://www.w3.org/2000/svg\" width=\"100\" height=\"100\"><x:script>alert('xss')</x:script><rect width=\"50\" height=\"50\"/></svg>"
result (svg/sanitize-svg svg)]
(t/is (not (clojure.string/includes? result "<x:script")))
(t/is (not (clojure.string/includes? result "alert")))
(t/is (clojure.string/includes? result "<rect")))))
(t/deftest sanitize-svg-arbitrary-prefixed-script
(t/testing "sanitize-svg removes script tags written with an arbitrary namespace prefix"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:p=\"http://www.w3.org/2000/svg\" width=\"100\" height=\"100\"><p:script>alert('xss')</p:script><rect width=\"50\" height=\"50\"/></svg>"
result (svg/sanitize-svg svg)]
(t/is (not (clojure.string/includes? result "<p:script")))
(t/is (not (clojure.string/includes? result "alert")))
(t/is (clojure.string/includes? result "<rect")))))
(t/deftest sanitize-svg-nested-prefixed-script
(t/testing "sanitize-svg removes namespace-prefixed script tags from nested elements"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:x=\"http://www.w3.org/2000/svg\" width=\"100\" height=\"100\"><g><x:script>alert('xss')</x:script></g></svg>"
result (svg/sanitize-svg svg)]
(t/is (not (clojure.string/includes? result "<x:script")))
(t/is (not (clojure.string/includes? result "alert")))
(t/is (clojure.string/includes? result "<g")))))
(t/deftest sanitize-svg-prefixed-dangerous-tags
(t/testing "sanitize-svg removes dangerous animation elements written with a namespace prefix"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:x=\"http://www.w3.org/2000/svg\" width=\"100\" height=\"100\"><x:foreignObject width=\"10\" height=\"10\"/><x:set attributeName=\"onmouseover\" to=\"alert('xss')\"/><x:animate attributeName=\"fill\" to=\"red\"/><x:animateTransform attributeName=\"transform\"/><rect width=\"50\" height=\"50\"/></svg>"
result (svg/sanitize-svg svg)]
(t/is (not (clojure.string/includes? result "foreignObject")))
(t/is (not (clojure.string/includes? result "<x:set")))
(t/is (not (clojure.string/includes? result "<x:animate")))
(t/is (not (clojure.string/includes? result "alert")))
(t/is (clojure.string/includes? result "<rect")))))
(t/deftest sanitize-svg-prefixed-javascript-href
(t/testing "sanitize-svg removes javascript: URLs from href attributes written with a namespace prefix"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:x=\"http://www.w3.org/2000/svg\" width=\"100\" height=\"100\"><a x:href=\"javascript:alert('xss')\"><rect width=\"50\" height=\"50\"/></a></svg>"
result (svg/sanitize-svg svg)]
(t/is (not (clojure.string/includes? result "javascript:")))
(t/is (not (clojure.string/includes? result "alert")))
(t/is (clojure.string/includes? result "<a")))))
(t/deftest sanitize-svg-prefixed-event-handlers
(t/testing "sanitize-svg removes event handler attributes written with a namespace prefix"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:x=\"http://www.w3.org/2000/svg\" width=\"100\" height=\"100\" x:onload=\"alert('xss')\"><rect width=\"50\" height=\"50\" x:onclick=\"alert('xss')\"/></svg>"
result (svg/sanitize-svg svg)]
(t/is (not (clojure.string/includes? result "onload")))
(t/is (not (clojure.string/includes? result "onclick")))
(t/is (not (clojure.string/includes? result "alert")))
(t/is (clojure.string/includes? result "<rect")))))
(t/deftest sanitize-svg-prefixed-xlink-namespace-href
(t/testing "sanitize-svg removes javascript: URLs from href written with a prefix bound to the xlink namespace"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:y=\"http://www.w3.org/1999/xlink\" width=\"100\" height=\"100\"><a y:href=\"javascript:alert('xss')\"><rect width=\"50\" height=\"50\"/></a></svg>"
result (svg/sanitize-svg svg)]
(t/is (not (clojure.string/includes? result "javascript:")))
(t/is (not (clojure.string/includes? result "alert")))
(t/is (clojure.string/includes? result "<a")))))
(t/deftest sanitize-svg-preserved-prefixed-attrs
(t/testing "sanitize-svg preserves legitimate attributes written with a namespace prefix"
(let [svg "<svg xmlns=\"http://www.w3.org/2000/svg\" xmlns:xml=\"http://www.w3.org/XML/1998/namespace\"><text xml:space=\"preserve\">hola</text></svg>"
result (svg/sanitize-svg svg)]
(t/is (clojure.string/includes? result "xml:space"))
(t/is (clojure.string/includes? result "hola")))))
(t/deftest info-invalid-image
(t/testing "info on invalid image raises error"
(let [path (fs/create-tempfile :prefix "penpot-test-" :suffix ".jpg")]

31
backend/test/backend_tests/metrics_test.clj
View File

@ -10,11 +10,13 @@
[app.metrics :as mtx]
[app.metrics.definition :as-alias mdef]
[clojure.test :as t]
[integrant.core :as ig])
[integrant.core :as ig]
[promesa.exec :as px])
(:import
io.prometheus.client.Collector$MetricFamilySamples
io.prometheus.client.Collector$MetricFamilySamples$Sample
io.prometheus.client.CollectorRegistry))
io.prometheus.client.CollectorRegistry
java.util.concurrent.ScheduledThreadPoolExecutor))
(def ^:private valid-definitions? @#'app.metrics/valid-definitions?)
@ -136,3 +138,28 @@
::mdef/help "typo check"
::mdef/type :histogram
::mdef/bucksets [100]}}))))
(t/deftest create-sampler-reschedules-after-error
;; The docstring promise, tested once for both call sites: an unexpected error
;; on a single sample must not cancel the following runs. The first sample
;; runs immediately and throws; the next one must still be scheduled.
(let [calls (atom 0)
sampler (mtx/create-sampler 1000 (fn []
(swap! calls inc)
(throw (ex-info "boom" {}))))]
(try
(t/is (loop [i 0]
(cond (pos? @calls) true
(> i 200) false
:else (do (Thread/sleep 10) (recur (inc i)))))
"the first sample must run immediately")
(let [queue (.getQueue ^ScheduledThreadPoolExecutor sampler)]
(t/is (loop [i 0]
(cond (= 1 (.size queue)) true
(> i 200) false
:else (do (Thread/sleep 10) (recur (inc i)))))
"the next sample must be scheduled after the error"))
(finally
(px/shutdown-now sampler)))))

43
backend/test/backend_tests/nitrate_test.clj Normal file
View File

@ -0,0 +1,43 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns backend-tests.nitrate-test
(:require
[app.config :as cf]
[app.nitrate]
[clojure.test :as t]))
(def ^:private generate-nitrate-uri
(ns-resolve 'app.nitrate 'generate-nitrate-uri))
(t/deftest generate-nitrate-uri-test
(binding [cf/config (assoc cf/config
:admin-console-uri
"http://ac.example/admin-console")]
(doseq [[label segments expected]
[["single segment"
["api/connectivity"]
"http://ac.example/admin-console/api/connectivity"]
["resource identifier as the final segment"
["api/teams/" "team-id"]
"http://ac.example/admin-console/api/teams/team-id"]
["nested team membership path"
["api/teams/" "team-id/" "users/" "profile-id"]
"http://ac.example/admin-console/api/teams/team-id/users/profile-id"]
["nested organization membership path"
["api/organizations/" "organization-id/" "members/" "profile-id"]
"http://ac.example/admin-console/api/organizations/organization-id/members/profile-id"]
["organization action path"
["api/organizations/" "organization-id/" "add-team"]
"http://ac.example/admin-console/api/organizations/organization-id/add-team"]
["user action path"
["api/users/" "profile-id/" "cleanup-after-deletion"]
"http://ac.example/admin-console/api/users/profile-id/cleanup-after-deletion"]
["team action path"
["api/teams/" "team-id/" "sso"]
"http://ac.example/admin-console/api/teams/team-id/sso"]]]
(t/testing label
(t/is (= expected (apply generate-nitrate-uri segments)))))))

125
backend/test/backend_tests/objects_gc_test.clj Normal file
View File

@ -0,0 +1,125 @@
;; 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/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns backend-tests.objects-gc-test
(:require
[app.common.logging :as l]
[app.common.time :as ct]
[app.db :as db]
[app.storage :as sto]
[app.tasks.objects-gc :as ogc]
[backend-tests.helpers :as th]
[clojure.test :as t]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(defn- create-deleted-file!
"Creates a file and applies the deletion cascade on it (the same task the RPC
uses), so its children are marked as deleted for the given date. Returns the
file."
[profile i deleted-at]
(let [file (th/create-file* i {:profile-id (:id profile)
:project-id (:default-project-id profile)})]
(th/run-task! :delete-object {:object :file
:deleted-at deleted-at
:id (:id file)})
file))
(defn- block-file!
"Leaves an unmarked `file_media_object` pointing at the file, which is what
happens in production: a child that the deletion cascade did not mark. Its
foreign key towards `file` is `NO ACTION`, so it blocks the file deletion."
[file]
(let [media (sto/put-object! (::sto/storage th/*system*)
{::sto/content (sto/content "media")
:content-type "text/plain"
:bucket "file-media-object"})]
(th/create-file-media-object* {:file-id (:id file)
:media-id (:id media)})))
(defn- find-file
[id]
(th/db-get :file {:id id} {::db/remove-deleted false}))
(defn- chunk-error
"The first captured log record that reports a skipped chunk for `obj`,
waiting for it because logging is asynchronous."
[records obj]
(let [deadline (+ (System/currentTimeMillis) 5000)]
(loop []
(let [record (first (filter (fn [record]
(let [props (::l/props record)]
(and (= obj (get props :obj))
(= "error on chunk deletion, skipping it"
(get props :hint)))))
@records))]
(cond
record record
(> (System/currentTimeMillis) deadline) nil
:else (do (Thread/sleep 10) (recur)))))))
(t/deftest deletes-the-pending-files
(let [profile (th/create-profile* 1)
file (create-deleted-file! profile 1 (ct/in-past "10m"))
result (th/run-task! :objects-gc {})]
(t/is (pos? (:processed result)))
(t/is (nil? (find-file (:id file))))))
(t/deftest profile-cascade-keeps-profile-deletion-date
;; The cascade marks the owned rows with the deletion date of the profile,
;; like the RPC delete-profile flow does, not with the timestamp of the run.
;; The team survives because only the profiles chunk runs here, so its row
;; still shows that date.
(let [profile (th/create-profile* 1)
_ (th/db-update! :profile {:deleted-at (ct/in-past "30m")} {:id (:id profile)})
deleted-at (:deleted-at (th/db-get :profile {:id (:id profile)}
{::db/remove-deleted false}))
cfg {::db/pool th/*pool*
::sto/storage (::sto/storage th/*system*)
::ogc/threshold deleted-at}
total (#'ogc/delete-profiles-chunk cfg [(:id profile)])]
(t/testing "the profile is gone and the chunk reports it"
(t/is (= 1 total))
(t/is (nil? (th/db-get :profile {:id (:id profile)} {::db/remove-deleted false}))))
(t/testing "the owned team keeps the deletion date of the profile"
(t/is (= deleted-at (:deleted-at (th/db-get :team {:id (:default-team-id profile)}
{::db/remove-deleted false})))))))
(t/deftest blocked-chunk-does-not-stop-the-run
;; Chunks of one file: the blocked file takes down its own chunk and nothing
;; else, so the clean file of the next chunk is still deleted and the run
;; finishes. The next run retries the blocked file.
(let [profile (th/create-profile* 1)
blocked (create-deleted-file! profile 1 (ct/in-past "30m"))
clean (create-deleted-file! profile 2 (ct/in-past "20m"))
_ (block-file! blocked)
records (atom [])
_ (add-watch l/log-record ::capture
(fn [_ _ _ record] (swap! records conj record)))
result (try
(th/run-task! :objects-gc {:chunk-size 1})
(finally
(remove-watch l/log-record ::capture)))]
(t/testing "the clean file of the next chunk is deleted"
(t/is (nil? (find-file (:id clean)))))
(t/testing "the blocked file is still pending"
(t/is (some? (find-file (:id blocked)))))
(t/testing "the failed chunk is reported"
(t/is (some? (chunk-error records "file"))))
(t/testing "the run finishes"
(t/is (pos? (:processed result))))))

Some files were not shown because too many files have changed in this diff Show More