github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 14:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

🔥 Retire the legacy app.* tree from the exporter

Browse Source 
Port the last live namespaces adapted to the new tree (config,
mime, object, resources, the wasm engines) with the temp ownership
folded into tmpdir, and delete src/app/ outright: 28 legacy files
gone, every behavior covered by the new suite.

The render env (uris, management key, tmpdir, image cache) now
travels in the lease message; the worker thread reads no config
and no globals. The generated shared.js moves next to the new
enums (build env, gitignore and docs follow it). Legacy tests fall
with a case-by-case parity check against the new suite.

Parity: api->consumer-api (7/7 same), worker->consumer+worker
slices, config/plan/jobs/shell/pool suites superseded, svg fills
moved to the new tree over the real module.

AI-assisted-by: muse-spark-1.3-contributor
This commit is contained in:
Andrey Antukh 2026-10-09 12:20:22 +00:00
parent e9346210d3
commit 46cf000635
66 changed files with 1508 additions and 3881 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -59,7 +59,7 @@ opencode.json
/exporter/target
/exporter/.shadow-cljs
/exporter/resources/wasm/
/exporter/src/app/wasm/shared.js
/exporter/src/exporter/wasm/shared.js
/frontend/.storybook/preview-body.html
/frontend/.storybook/preview-head.html
/frontend/playwright-report/

65
.serena/memories/exporter/core.md
View File

@ -8,25 +8,28 @@ on this side: the row of the job, its cancel and its result are the backend's.
## Layout and commands
- Source: `exporter/src/`; config: `deps.edn`, `shadow-cljs.edn`, `package.json`; runtime helpers/assets: `vendor/`, `scripts/`.
- Source: `exporter/src/` (one tree, `exporter.*`; the legacy `app.*` tree is
gone); config: `deps.edn`, `shadow-cljs.edn`, `package.json`; runtime helpers/assets: `vendor/`, `scripts/`.
- From `exporter/`: setup `./scripts/setup`; watch `pnpm run watch` or `pnpm run watch:app`; production build `pnpm run build`; test bundle `pnpm run build:test`; tests `pnpm run test` or `pnpm run test:quiet`; lint `pnpm run lint:clj`; format check/fix `pnpm run check-fmt:clj` / `pnpm run fmt:clj`. `./scripts/ci exporter` in the repo root is green (test-quiet defaults `PENPOT_SECRET_KEY` like `test` does).
- Because exporter consumes `common/`, shared file/shape/model changes may need exporter verification even when the immediate change is not under `exporter/`.
- Cross-cutting testing principles and anti-patterns: `mem:testing`.
- Exporter test conventions and CI: `mem:exporter/testing`.
- Promise chains in the exporter (management client, runner) follow promesa's two API families; arg orders, what each fn must return, the `->>` preference and the async-test silent-green trap: `mem:clojure/promesa` — read before touching promise code.
- No promesa chains in `src` (only raw JS promise interop where a JS API demands
it); async is `^:async` + `await`. Promise arg orders and the async-test
silent-green trap: `mem:clojure/promesa` — read before touching async code.
## The worker anatomy
- The queue wake-up contract (key shape, the two-item payload, mark-then-push, the claim-back rule) is the backend's public surface now: `mem:backend/core`, "The wake-up contract of a worker queue". This process was its first external consumer; read it before writing another.
- Main thread boots pools + K pollers (`core.cljs`): browser pool, wasm pool, temp-file cleaner (`jobs.utils/init`), then `consumer.worker/start!`. Shutdown: browser → wasm pool → pollers → done (the pollers own their connections; the pools unwind while an export is still in flight).
- K pollers (`app.consumer.worker`): one Redis connection per poller (connection = slot + backpressure), BLPOP on `penpot.worker.queue:<tenant>:exporter`, payload `[job-id scheduled-at]` JSON; corrupt payload warns and drops, dead Redis delays 1s and retries. `K = PENPOT_EXPORTER_WORKER_CONCURRENCY` default 2, floor 1; replicas × K is the total concurrency. Pools size themselves to K (`browser` and `wasm.pool` read `ccfg/concurrency`); there is no independent pool-max config anymore, only `:wasm-worker-pool-min`.
- Management client (`app.consumer.api`): claim/progress/create-job-session/complete-job (JSON and multipart via undici FormData)/fail-job, POST to `<internal-uri>/api/management/methods/<method>` with `X-Shared-Key: exporter <key>` (key = `PENPOT_EXPORTER_SHARED_KEY` or HKDF-derived from the secret); transit bodies, non-2xx errors carry `:status` and the error body.
- Runner (`app.consumer.exports`, `run-export!`): mints a render session (`create-job-session`), plans via `make-plan` (single → artifact of its type; multi → zip; frames → pdf via pdfunite), settles via `complete-job-with-artifact` multipart or `fail-job`; the settle never rejects. `app.consumer.plan` holds the render-plan pieces (name transducers, partition of 50, grouping by `[scale type]`).
- Main thread boots pools + K pollers (`exporter.main`): browser pool, wasm pool, temp area (`:exporter/tmpdir`, which also cleans what a previous process left on its init), then `consumer.worker/start`. Shutdown: browser → wasm pool → pollers → done (the pollers own their connections; the pools unwind while an export is still in flight).
- K pollers (`exporter.consumer.worker`): one Redis connection per poller (connection = slot + backpressure), BLPOP on `penpot.worker.queue:<tenant>:exporter`, payload `[job-id scheduled-at]` JSON; corrupt payload warns and drops, dead Redis delays 1s and retries. `K = PENPOT_EXPORTER_WORKER_CONCURRENCY` default 1 floor; replicas × K is the total concurrency. Pools size themselves to K (both read `consumer.config/concurrency`); there is no independent pool-max config anymore, only `:wasm-worker-pool-min`.
- Management client (`exporter.consumer.api`): claim/progress/create-job-session/complete-job (JSON and multipart via undici FormData)/fail-job, POST to `<internal-uri>/api/management/methods/<method>` with `X-Shared-Key: exporter <key>` (key = `PENPOT_EXPORTER_SHARED_KEY` or HKDF-derived from the secret); transit bodies, non-2xx errors carry `:status` and the error body. `fetch` is a plain def seam for hermetic tests.
- Runner (`exporter.consumer`, `run-export [render tmpdir claim params]`): mints a render session (`create-job-session`), plans via `make-plan` (single → artifact of its type; multi → zip; frames → pdf via pdfunite), settles via `complete-job-with-artifact` multipart or `fail-job`; the settle never rejects. `exporter.consumer.plan` holds the render-plan pieces (name transducers, partition of 50, grouping by `[scale type]`), dispatching on `exporter.renderer/wasm?`. The job kind is declared (`:kind` in the frozen params), never sniffed.
- Beats: per-object milestones `:preparing/:rendering/:packaging` with `objects`/`pages` counters, throttled at 250ms; a watchdog repeats the last milestone every 1s.
- Cancellation: a `skip` answer on any beat means the row is terminal (cancelled, aborted, settled). The runner raises `:job-cancelled` between units of work; mid-Skia the watchdog fires the local port once (`jobs/mark-cancelled`: flag + terminal local record + SharedArrayBuffer + terminate callbacks registered by `renderer.wasm/with-scope`), killing the leased worker thread. The runner owns the local registry entry via `jobs/register!` and releases it on settle.
- `app.jobs` is the **local cancel arm only**: a runtime registry keyed by job-id (`register!`, `mark-cancelled`, `cancel-signal`, `on-cancel`, `cancelled?`, `release!`). `mark-cancelled` marks the local record terminal BEFORE the callbacks run and returns true/nil (marked-now / no-op for unowned or settled). No redis writes.
- Temp files: `app.jobs.utils/track!`/`release!` per job id; a boot-time clean drops what a previous process left (aged `:exporter-job-ttl`). After the deletion there is no redis-side store, cancel topic or abandoned-job sweep: an unclaimed-in-time row goes `aborted` by the backend's own lease GC.
- Cancellation: a `skip` answer on any beat means the row is terminal (cancelled, aborted, settled). The runner raises `:job-cancelled` between units of work; mid-Skia the per-lease interval fires the SharedArrayBuffer signal and terminates the leased worker thread. The runner owns the local registry entry via `exporter.jobs` and releases it on settle.
- `exporter.jobs` is the **local cancel arm only**: one flag per claimed job (`register`/`mark-cancelled` returning true/nil/`cancelled?`/`release`) plus one zero-arg check constructor per job (`check-cancelled`, raising `:job-cancelled`). No terminate callbacks and no shared-array signal travel through here — the abort belongs to whoever holds the render (the per-lease interval of `exporter.wasm.scope` terminates its own worker).
- Temp files: `exporter.tmpdir/track`/`release` per job id; the `:exporter/tmpdir` init cleans orphans (aged `:job-ttl`). No redis-side store, cancel topic or abandoned-job sweep: an unclaimed-in-time row goes `aborted` by the backend's own lease GC.
- Run artifacts: `exporter.resources` (`create [tmpdir type name]`, `create-zip`/`add-to-zip`/`close-zip`); no per-file deletion timers — the tmpdir registry owns every path.
## Running it (devenv and deploy)
@ -34,47 +37,39 @@ on this side: the row of the job, its cancel and its result are the backend's.
- Deploy: the compose service is one `penpot-exporter` (the same image, `CMD ["node", "app.js"]`); scale by replicas, K is per process. Nginx has no `/api/export` route anymore: the frontend talks to the backend's RPC only (`create-export-assets-job`), and downloads ride `/assets/by-id/?share-id=`/auth of the job resource.
- Useful beats while debugging: the boot log names `:workers K`; each poller logs `running job`/`job settled`; the runner logs `export job settled` with `:outcome`, and a cancel logs `job cancelled by backend` on the watchdog.
## The new tree (refactor in progress)
## The tree
- New code grows under `exporter.*`, in parallel to the legacy `app.*` tree: `exporter.main` will replace `app.core` once every piece is ported; do not extend `app.*`.
- Lifecycle is `exporter.utils.system`: async-aware Integrant-style init/halt (`init-key`/`halt-key` multimethods, `ref`s, `weavejester.dependency` ordering, `^:async` + `cljs.core/await`, no promesa chains); tests are `^:async deftest` with `await` directly in the body.
- First ported service is `exporter.browser` (whole `app.browser` at once): the running instance is the raw pool, the public API takes it first (`exec` fails fast on a nil pool), the browser factory is injected through config for hermetic tests, and the new tree carries no promesa.
- `exporter.main` mirrors the backend's `app.main`: a `system-config` def reading env at the wiring layer, a public `system` atom with the running map, `start`/`stop`/`restart` (`^:async`, resolving `:started`/`:stopped`/`:restarted`), a thread guard in `start` (a render worker thread runs this same bundle and boots the legacy `app.wasm.worker` engine instead of the system — without it a warmed pool worker would nest pools and pollers and never post `ready`), `start-custom` as the test seam, idempotent `install-process-handlers` for the `uncaughtException`/SIGTERM/SIGINT wiring (runs on `start`, never on namespace load), `^:dev/before-load-async`/`^:dev/after-load-async` hooks bridging the promise lifecycle to shadow's `done` callbacks (a hook failure logs, never sticks the reload), and `main` as the entry point: shadow boots `exporter.main/main`, and the old `app.core` reload path (`stop` and the `:devtools` wiring) sits commented out until `app.*` is fully ported. The entry leaves info logging enabled for the new tree (`setup!` on the `exporter` logger, mirroring the old `{:app :info}`); without it the default level filters everything below fatal.
- `exporter.main` mirrors the backend's `app.main`: a `system-config` def reading env at the wiring layer, a public `system` atom with the running map, `start`/`stop`/`restart` (`^:async`, resolving `:started`/`:stopped`/`:restarted`), a thread guard in `start` (a render worker thread runs this same bundle and boots the `exporter.wasm.worker` engine instead of the system — without it a warmed pool worker would nest pools and pollers and never post `ready`), `start-custom` as the test seam, idempotent `install-process-handlers` for the `uncaughtException`/SIGTERM/SIGINT wiring (runs on `start`, never on namespace load), `^:dev/before-load-async`/`^:dev/after-load-async` hooks bridging the promise lifecycle to shadow's `done` callbacks (a hook failure logs, never sticks the reload), and `main` as the entry point: shadow boots `exporter.main/main`. The entry leaves info logging enabled for the new tree (`setup!` on the `exporter` logger); without it the default level filters everything below fatal.
- Service config maps take plain (non-namespaced) param keys (`{:exporter.browser/pool {:max 2}}`): the top-level key already scopes the component, so namespacing the params only adds noise. Component keys and error reasons stay namespaced.
- `exporter.config` is the process configuration: `PENPOT_`-prefixed env over defaults, malli-decoded and validated; `get`/`get-internal-uri`/`management-key` (HKDF)/`flags`/`version`. `prepare-config` over an explicit env object is pure and throws `:invalid-config` (tests exercise it); only the wiring entry `load-config!` reads the live environment and exits on it.
- `exporter.browser` is the browser pool service: the running instance is the raw pool, the public API takes it first (`exec` fails fast on a nil pool), the browser factory is injected through config for hermetic tests.
- `exporter.wasm.pool` follows the backend `db/run!` shape: `run [cfg f & args]` resolves the pool from `cfg` (the `:exporter.wasm/pool` service instance, or a raw pool), acquires a worker, applies `f` to the cfg carrying it under `:exporter.wasm.pool/worker` plus any extra args, and returns the worker — or destroys it when `f` fails, like a rollback. Pure pool mechanics only (`init`/`halt`, `terminate`, `await-ready`); the render protocol lives one level up.
- `exporter.wasm.scope` owns the lease: `run [cfg on-scope]` lends one worker for the whole batch (serializer, per-lease signal buffer, mid-render abort interval), and the public low-level `render-on [cfg params]` renders on the leased worker — asserting `:worker-not-leased`/`:timeout-ms-missing` (`:assertion`, never a silent default: a bare `::key` resolves to the CURRENT ns, never to an alias, so cross-ns keys are literals or `::alias/key`) — with the rest preconfigured and namespaced by setter (`:exporter.renderer/on-object` from the caller, `:exporter.wasm.scope/cancel-buffer` from the lease); the check is mandatory at the lease entry and runs here when configured.
- `exporter.renderer.browser` merges the bitmap/pdf/svg flows into one `render [cfg params on-object check-cancelled]` (branching by type, `on-object` always awaited, unknown types raise); `cfg` carries what the job params do not freeze (`:exporter.browser/pool`, `:base-uri`, `:public-uri`, `:svgo?`). Dead xml predicates from the old tree did not survive the merge.
- `exporter.renderer.browser` merges the bitmap/pdf/svg flows into one `render [cfg params on-object check-cancelled]` (branching by type, `on-object` always awaited, unknown types raise); `cfg` carries what the job params do not freeze (`:exporter.browser/pool`, `:base-uri`, `:public-uri`, `:svgo?`).
- `exporter.browser.scope` owns the browser batch: `run [cfg exports]` fires every export through its own checkout, all at once, bounded by the pool. No lease — a browser batch shares nothing but the pool, so fan-out only. The facade validates once, partitions by backend and joins both scopes.
- `exporter.renderer.wasm` is a thin single-shot over the scope lease. The scope fn survives one level down, as `exporter.wasm.scope/run`.
- `exporter.renderer` is the malli-validated facade with one entry point, the `render-fn` closure over `cfg`: it validates the task map (`:exports :on-object :check-cancelled`) and dispatches it through `render [cfg task]`, which assumes a valid task and only partitions and joins — the browser exports through `exporter.browser.scope`, the wasm ones through one leased worker — resolving nil once every export landed (objects travel through `on-object`). The `:exporter/renderer` service builds the closure from pools plus tmpdir (refs) and static config. The consumer renders through the injected fn and never requires the facade. `cfg` is task-free infrastructure with process lifetime (pools, uris, flags, tmpdir); everything per-task rides in the validated task map. One closed schema validates data plus injections, so a bad task — or a misspelled key — never touches a pool; task validation raises `:data-validation`. Each driver takes the same `[cfg params on-object check-cancelled]` shape (`headless?` is now `wasm?`: the browser also renders headless, so the old name lied) and implements cancel internally: cooperative checkpoints on the browser, checkpoints plus a mid-render abort of its own leased worker on wasm. The lease lives one level down, in `exporter.wasm.scope/run`, which the facade calls with the task keys set once in `cfg`; the browser batch goes through `exporter.browser.scope/run [cfg exports]`.
- `exporter.jobs` is the local cancel arm, smaller than the legacy `app.jobs`: one flag per claimed job (`register`/`mark-cancelled` returning true/nil/`cancelled?`/`release`) and one zero-arg check constructor per job (`check-cancelled`, raising `:job-cancelled`). No terminate callbacks and no shared-array signal travel through here — the abort belongs to whoever holds the render (the per-lease interval of `exporter.wasm.scope` terminates its own worker). The runner releases the registry entry on every settle; the legacy runner never did (one leaked entry per job).
- `exporter.consumer.plan` is the render plan (`prepare-exports`, `count-objects`, `sanitize-file-regex`), dispatching on `exporter.renderer/wasm?` instead of the legacy `headless?`.
- `exporter.consumer` is the runner: `run-export [render tmpdir claim params]` keeps the legacy beats/watchdog/settle (first breath, render session, multipart complete or `fail-job`, temp release) but renders through the injected render fn with one check from `exporter.jobs` shared between units of work and drivers. `render` and `tmpdir` are the injected dependencies; the claim names the job, `params` carries the frozen job params. The job kind is declared, never sniffed: `make-plan` reads the top-level `:kind` (`:frames` joins pages into one pdf, anything else runs the shapes flow of single/zip), so there is no typeless-items convention and `normalize-items` only coerces wire strings. The settle never rejects; only bugs of this process do.
- `exporter.tmpdir` owns the temp-file area (`:exporter/tmpdir`): the legacy shell creates its dir at namespace load, so referencing the var inside `init-key` pulls that moment into the lifecycle (fail fast on a bad `:tempdir`, ordered before the renderer that writes to it). Named for what it owns, not for the legacy namespace.
- `exporter.consumer.api` is the backend management client (claim/progress/session/settle, transit bodies, multipart artifact), a faithful `^:async` port with no promesa chains and the same `fetch` def seam for hermetic tests.
- `exporter.consumer.config` holds the consumer knobs (`concurrency` floored at 1, `queue-key`, `queue-name`): the runner, the worker and `exporter.main` read it, so no namespace under `exporter.*` depends on `app.consumer.*` anymore.
- `exporter.consumer.worker` is the queue poller (`read-payload`, `process`, `poll-once`, `start`/`stop` with a running flag, no promesa): K connections over the `:exporter` queue, claim → `run-export` through the injected `:renderer` and `:exporter/tmpdir` → settle before the next pop. The worker config carries the queue knobs plus both by ref; no render statics nest inside it. `stop` quits every connection and ends every loop (the legacy loops kept failing turns after the stop); boot cleans orphaned temp files first.
- `exporter.main` wires both pools (`:exporter.browser/pool` and `:exporter.wasm.pool/pool`, each sized to the worker concurrency) plus `:exporter/tmpdir` (path from env) plus `:exporter/renderer` (pools and tmpdir as `ref`s, static uris/flags) plus `:exporter.consumer/worker` (`:renderer` and `:exporter/tmpdir` by ref, `:concurrency`, `:queue-key`). Service keys follow the domain (`:exporter.wasm/pool`, `:exporter.consumer/worker`), written `::alias/name` where an alias covers them. No test boots the production wiring: the wasm pool warms one worker eagerly and the worker script in a test process would be the test bundle itself; the wiring is asserted as data and the lifecycle rides fake configs.
- `exporter.renderer` is the malli-validated facade with one entry point, the `render-fn` closure over `cfg`: it validates the task map (`:exports :on-object :check-cancelled`) and dispatches it through `render [cfg task]`, which assumes a valid task and only partitions and joins — the browser exports through `exporter.browser.scope`, the wasm ones through one leased worker — resolving nil once every export landed (objects travel through `on-object`). The `:exporter/renderer` service builds the closure from pools plus tmpdir (refs) and static config (`:base-uri`, `:public-uri`, `:management-key`, `:image-cache-size`, `:svgo?`). The facade merges the render env (`::wrender/env`) into every wasm export's params before the lease: the worker thread reads no config and no globals. The consumer renders through the injected fn and never requires the facade. `cfg` is task-free infrastructure with process lifetime (pools, uris, key, flags, tmpdir); everything per-task rides in the validated task map. One closed schema validates data plus injections, so a bad task — or a misspelled key — never touches a pool; task validation raises `:data-validation`. Each driver takes the same `[cfg params on-object check-cancelled]` shape (`headless?` is now `wasm?`: the browser also renders headless, so the old name lied) and implements cancel internally: cooperative checkpoints on the browser, checkpoints plus a mid-render abort of its own leased worker on wasm. The lease lives one level down, in `exporter.wasm.scope/run`, which the facade calls with the task keys set once in `cfg`; the browser batch goes through `exporter.browser.scope/run [cfg exports]`.
- `exporter.consumer.worker` is the queue poller (`read-payload`, `process`, `poll-once`, `start`/`stop` with a running flag, no promesa): K connections over the `:exporter` queue, claim → `run-export` through the injected `:renderer` and `:exporter/tmpdir` → settle before the next pop. The worker config carries the queue knobs plus both by ref; no render statics nest inside it. `stop` quits every connection and ends every loop; the temp area boots clean through the tmpdir init.
- `exporter.consumer.config` holds the consumer knobs (`concurrency` floored at 1, `queue-key`, `queue-name`): the runner, the worker and `exporter.main` read it.
- `exporter.consumer.api` is the backend management client (claim/progress/session/settle, transit bodies, multipart artifact), with the same `fetch` def seam for hermetic tests.
- `exporter.wasm` is the headless render-wasm driver under Node (artifact load + headless boot, font provisioning, shape rendering); `exporter.wasm.enums` binds the generated `shared.js` the `render-wasm/build export` step emits next to it (not committed). `exporter.wasm.text`/`serialize` own the browser-free call sequencing over the shared serializers.
- `exporter.wasm.render` is the headless pipeline (fetch scene → serialize → provision fonts/images → relayout → render each object) as `[env params on-object]`: `env` carries `:internal-uri`, `:public-uri`, `:management-key`, `:tmpdir`, `:image-cache-size`, and `fetch` is a plain def seam. `exporter.wasm.worker` is the worker-thread entry: it splits `::render/env` off the posted params (asserting `:env-missing`), assocs the cancel fn from the shared buffer, runs the pipeline posting `object`/`done`, and posts `error` instead of ever rejecting.
- `exporter.main` wires both pools (`:exporter.browser/pool` and `:exporter.wasm.pool/pool`, each sized to the worker concurrency) plus `:exporter/tmpdir` (path + job ttl from env) plus `:exporter/renderer` (pools and tmpdir as `ref`s, static uris/key/flags) plus `:exporter.consumer/worker` (`:renderer` and `:exporter/tmpdir` by ref, `:concurrency`, `:queue-key`). Service keys follow the domain (`:exporter.wasm/pool`, `:exporter.consumer/worker`), written `::alias/name` where an alias covers them. No test boots the production wiring: the wasm pool warms one worker eagerly and the worker script in a test process would be the test bundle itself; the wiring is asserted as data and the lifecycle rides fake configs.
- Async test vars prove their chain only when really awaited: a test passing with 0 assertions means the chain broke upstream.
## Render details
- Headless engines (wasm/Skia) lease one render worker for the whole run (`rd/with-scope`); browser renders go one DOM page per partition of 50.
- Headless engines (wasm/Skia) lease one render worker for the whole run (`scope/run`); browser renders go one DOM page per partition of 50.
- Each export gets a fresh Playwright browser context. On success the context closes and the browser returns to the pool; on error the browser is destroyed instead of reused. Borrow validates the connection; pool acquire timeout about 10s; font loading timeout logs a warning and continues after about 15s.
- Bitmap export differs for WASM vs non-WASM render paths: WASM forces Playwright `deviceScaleFactor` to 1 and passes scale through the render URL; non-WASM uses `deviceScaleFactor = scale`.
- WebP is produced by taking a PNG screenshot and converting it with ImageMagick.
- SVG export rasterizes text foreignObjects to PNG, converts through PPM/color masks/potrace, and reassembles SVG paths. It also replaces non-breaking spaces for SVG compatibility and drops empty defs/paths.
- PDF export injects `@page` sizing through raw browser `evaluate` JavaScript; that code cannot rely on CLJS runtime helpers.
- ZIP entry names are sanitized (`plan/sanitize-file-regex`) and duplicates receive numeric suffixes.
- ZIP entry names are sanitized and duplicates receive numeric suffixes.
## On the render engines (do not lose in refactors)
- The wasm engines run on worker threads; the Skia wasm bundle needs
`../render-wasm/build export` to generate `src/app/wasm/shared.js` before
compiling.
- A render thread cannot read a flag: the cancel reaches it through the
SharedArrayBuffer signal, and a render that never answers is killed by the
terminate watchdog of `app.wasm.pool` (the same mechanism a hard cancel
rides on).
- `core.cljs` decides what boots by thread: the main thread consumes the
queue, a render worker (`wasm.worker/main`) renders.
- The wasm engines run on worker threads; `../render-wasm/build export` must run first: it emits the artifact into `exporter/resources/wasm` and `src/exporter/wasm/shared.js` (both uncommitted) before compiling.
- A render thread cannot read a flag: the cancel reaches it through the SharedArrayBuffer signal, and a render that never answers is killed by the silence watchdog of `exporter.wasm.scope` (the same mechanism a hard cancel rides on).
- `exporter.main/start` decides what boots by thread: the main thread consumes the queue, a render worker (`exporter.wasm.worker/main`) renders.

2
exporter/scripts/build
View File

@ -9,7 +9,7 @@ pnpm install || exit 1;
pnpm run build:wasm;
WASM_SRC="resources/wasm";
WASM_SHARED="src/app/wasm/shared.js";
WASM_SHARED="src/exporter/wasm/shared.js";
if [ ! -f "$WASM_SRC/render-wasm.wasm" ] || [ ! -f "$WASM_SHARED" ]; then
echo "ERROR: the render-wasm build did not produce:" >&2;
echo " $WASM_SRC/render-wasm.wasm" >&2;

4
exporter/shadow-cljs.edn
View File

@ -6,10 +6,6 @@
{:target :esm
:runtime :node
:output-dir "target/"
;; Old reload hooks, superseded by the ^:dev metadata on the
;; exporter.main vars. Listing both would run every hook twice.
;; :devtools {:before-load-async app.core/stop
;; :after-load app.core/start}
:modules
{:app

218
exporter/src/app/browser.cljs
View File

@ -1,218 +0,0 @@
;; 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.browser
(:refer-clojure :exclude [eval])
(:require
["generic-pool" :as gp]
["generic-pool/lib/errors.js" :as gpe]
["playwright" :as pw]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.consumer.config :as ccfg]
[app.util.object :as obj]
[promesa.core :as p]))
(l/set-level! :trace)
(def TimeoutError gpe/TimeoutError)
;; --- BROWSER API
(def default-timeout 30000)
(def default-viewport-width 1920)
(def default-viewport-height 1080)
(def default-user-agent
(str "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 "
"(KHTML, like Gecko) Chrome/99.0.3729.169 Safari/537.36"))
(defn create-cookies
[uri {:keys [name token] :or {name "auth-token"}}]
(let [domain (str (:host uri)
(when (:port uri)
(str ":" (:port uri))))]
#js [#js {:domain domain
:path "/"
:name name
:value token}]))
(defn nav
([page url] (nav page url nil))
([page url {:keys [wait-until timeout] :or {wait-until "networkidle" timeout 20000}}]
(.goto ^js page (str url) #js {:waitUntil wait-until :timeout timeout})))
(defn sleep
[page ms]
(.waitForTimeout ^js page ms))
(defn wait-for-fonts
"Wait until the browser has finished loading all fonts.
Checking `document.fonts.status === 'loaded'` on its own is not enough:
the render page injects its `@font-face` rules asynchronously and the
browser only loads a face lazily, when some painted text actually uses
it. A face that is declared but not yet requested stays in the `unloaded`
state, which does NOT keep `document.fonts.status` at `loading`, so the
check can pass before any real font glyphs are available. The export is
then captured with a (usually wider) fallback font, and auto-width text
laid out with the real font metrics overflows its bounds and gets clipped.
To avoid that we explicitly request every declared face and await
`document.fonts.ready` before checking the status."
([page] (wait-for-fonts page nil))
([page {:keys [timeout] :or {timeout 15000}}]
(-> (.waitForFunction ^js page
"async () => {
if (!document.fonts) return true;
try {
await Promise.all(Array.from(document.fonts, (face) => face.load()));
} catch (e) {}
await document.fonts.ready;
return document.fonts.status === 'loaded';
}"
nil
#js {:timeout timeout})
(p/catch (fn [cause]
(l/warn :hint "wait-for-fonts timed out; continuing anyway"
:cause (ex-message cause))
(p/resolved nil))))))
(defn wait-for
([locator] (wait-for locator nil))
([locator {:keys [state timeout] :or {state "visible" timeout 10000}}]
(.waitFor ^js locator #js {:state state :timeout timeout})))
(defn screenshot
([frame] (screenshot frame {}))
([frame {:keys [full-page? omit-background? type quality path]
:or {type "png" full-page? false omit-background? false quality 95}}]
(let [options (-> (obj/new)
(obj/set! "type" (name type))
(obj/set! "omitBackground" omit-background?)
(cond-> path (obj/set! "path" path))
(cond-> (= "jpeg" type) (obj/set! "quality" quality))
(cond-> full-page? (-> (obj/set! "fullPage" true)
(obj/set! "clip" nil))))]
(.screenshot ^js frame options))))
(defn emulate-media
[page {:keys [media]}]
(.emulateMedia ^js page #js {:media media})
page)
(defn pdf
([page] (pdf page {}))
([page {:keys [scale path page-ranges]
:or {page-ranges "1"
scale 1}}]
(.pdf ^js page #js {:path path
:scale scale
:pageRanges page-ranges
:printBackground true
:preferCSSPageSize true})))
(defn eval
[frame f]
(.evaluate ^js frame f))
(defn select
[frame selector]
(.locator ^js frame selector))
(defn select-all
[frame selector]
(.$$ ^js frame selector))
;; --- BROWSER STATE
(defonce pool (atom nil))
(defonce pool-browser-id (atom 1))
(def browser-pool-factory
(letfn [(create []
(p/let [opts #js {:args #js ["--allow-insecure-localhost" "--font-render-hinting=none"]}
browser (.launch pw/chromium opts)
id (swap! pool-browser-id inc)]
(l/info :origin "factory" :action "create" :browser-id id)
(unchecked-set browser "__id" id)
browser))
(destroy [obj]
(let [id (unchecked-get obj "__id")]
(l/info :origin "factory" :action "destroy" :browser-id id)
(.close ^js obj)))
(validate [obj]
(let [id (unchecked-get obj "__id")]
(l/info :origin "factory" :action "validate" :browser-id id :obj obj)
(p/resolved (.isConnected ^js obj))))]
#js {:create create
:destroy destroy
:validate validate}))
(defn init
[]
(let [opts #js {:max (max 1 (ccfg/concurrency))
:min 0
:testOnBorrow true
:evictionRunIntervalMillis 5000
:numTestsPerEvictionRun 5
;; :acquireTimeoutMillis 120000 ; 2min
:acquireTimeoutMillis 10000 ; 10 s
:idleTimeoutMillis 10000}]
(l/info :hint "initializing browser pool" :opts opts)
(reset! pool (gp/createPool browser-pool-factory opts))
(p/resolved nil)))
(defn stop
[]
(when-let [pool (deref pool)]
(l/info :hint "finalizing browser pool")
(p/do!
(.drain ^js pool)
(.clear ^js pool))))
(defn- ex-ignore
[p]
(p/handle p (constantly nil)))
(defn- translate-browser-errors
[cause]
(if (instance? TimeoutError cause)
(ex/raise :type :internal
:code :timeout
:hint (ex-message cause)
:cause cause)
(p/rejected cause)))
(defn exec
[config handle]
(letfn [(handle-browser [browser]
(p/let [id (unchecked-get browser "__id")
context (.newContext ^js browser config)]
(l/trace :hint "exec:handle:start" :browser-id id)
(p/let [page (.newPage ^js context)
result (handle page)]
(.close ^js context)
(l/trace :hint "exec:handle:end" :browser-id id)
result)))
(on-acquire [pool browser]
(-> (handle-browser browser)
(p/then (fn [result]
(.release ^js pool browser)
result))
(p/catch (fn [cause]
(p/do!
(ex-ignore (.destroy ^js pool browser))
(p/rejected cause))))))]
(when-let [pool (deref pool)]
(-> (p/do! (.acquire ^js pool))
(p/then (partial on-acquire pool))
(p/catch translate-browser-errors)))))

156
exporter/src/app/consumer/api.cljs
View File

@ -1,156 +0,0 @@
;; 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.consumer.api
"The backend management API client.
The only place of the worker that speaks HTTP: every method of the
backend ledger (claim, progress, session, settle) travels through
here, with the shared key the exporter was configured with and, when
a call renders as a user, the Bearer token of its session. Request
bodies travel as transit+json (except the artifact form of
`complete-job`, which is multipart, like every other upload) and the
answers come back as transit too."
(:require
["node:fs/promises" :as fsp]
["undici" :as http]
[app.common.exceptions :as ex]
[app.common.transit :as t]
[app.common.uri :as u]
[app.config :as cf]
[cljs.core :as c]
[promesa.core :as p]))
(def fetch
"The network entry point of the client: a plain def, redefined by the
tests of the client, which never need a network."
http/fetch)
;; ---- THE REQUEST
(defn- dispatcher
"The agent of one request: a self-signed certificate happens in
deployments the same way the existing uploads already accept."
[]
(new http/Agent #js {:connect #js {:rejectUnauthorized false}}))
(defn- method-uri
[method]
(-> (cf/get-internal-uri)
(u/ensure-path-slash)
(u/join (str "api/management/methods/" (c/name method)))
(str)))
(defn- shared-key
"What every management call carries: the key id of this exporter plus
the key, and the wish to read transit back."
[]
#js {"X-Shared-Key" (str "exporter " cf/management-key)
"Accept" "application/transit+json"})
(def ^:private parse-response
"The answer of a management call: transit when it lands. A non-200 is
the failure of the call, with the error body the backend answered;
a body that does not decode stays as the plain text it came as."
(fn [response]
(let [status (.-status response)]
(->> (.text response)
(p/fmap (fn [text]
(let [body (let [decoded (ex/try! (t/decode-str text))]
(if-not (ex/exception? decoded) decoded text))]
(if (= status 200)
body
(ex/raise :type :internal
:code :failed-management-request
:status status
:response body)))))))))
(defn- request
"POST `params` to a management method as transit+json. The content
type travels on every call: without it the backend never parses the
body as transit and validates an empty map."
[method params]
(->> (fetch (method-uri method)
#js {:method "POST"
:headers (doto (shared-key)
(unchecked-set "Content-Type" "application/transit+json"))
:body (t/encode-str params)
:dispatcher (dispatcher)})
(p/mcat parse-response)))
(defn- request-multipart
"POST a FormData body to a management method. The content type is
settled by the FormData itself (boundary included), so only the
shared key goes in the headers."
[method form-data]
(->> (fetch (method-uri method)
#js {:method "POST"
:headers (shared-key)
:body form-data
:dispatcher (dispatcher)})
(p/mcat parse-response)))
;; ---- THE METHODS
(defn claim-job
"Request a queued job from the backend. The answer is either
`{:action :run :name ... :params ...}` (this poller owns the job) or
`{:action :skip ...}` (something else won it, or it is gone)."
[job-id scheduled-at]
(request :claim-job {:job-id job-id :scheduled-at scheduled-at}))
(defn report-job-progress
"The heartbeat of a running job: the stage hitos of the progress
contract plus the counters of the current work. A `:skip` says the
job can no longer hear the worker (cancelled, aborted, settled)."
[job-id progress]
(request :report-job-progress {:job-id job-id :progress progress}))
(defn create-job-session
"Mint an authentication session of the owner of a running job, so the
render views authenticate as the user, not as a machine."
[job-id]
(request :create-job-session {:job-id job-id}))
(defn complete-job
"Close a job whose result is the plain value `result`, with an
optional `:resource-id` this worker already owns (the internal path)
and an optional `:session-id` to close."
([job-id result]
(complete-job job-id result nil))
([job-id result {:keys [resource-id session-id]}]
(request :complete-job
(cond-> {:job-id job-id :result result}
(some? resource-id) (assoc :resource-id resource-id)
(some? session-id) (assoc :session-id session-id)))))
(defn complete-job-with-artifact
"Close a job whose result is the artifact itself: the backend stores
the bytes and derives the result descriptor. `artifact` says what it
is (`:path`, `:filename`, `:mtype`); `ctx` names the job and, when
the worker rendered with a session, the one to close."
[{:keys [job-id session-id]} {:keys [path filename mtype]}]
(->> (fsp/readFile (str path))
(p/fmap (fn [buffer]
(let [blob (new js/Blob #js [buffer] #js {:type mtype})
fdata (new http/FormData)]
(.append fdata "job-id" (str job-id))
(.append fdata "content" blob filename)
(.append fdata "filename" filename)
(.append fdata "mtype" (str mtype))
(when session-id
(.append fdata "session-id" (str session-id)))
fdata)))
(p/mcat (fn [fdata]
(request-multipart :complete-job fdata)))))
(defn fail-job
"Close a job as failed with the rich error the backend stores for
`job.error`. `:session-id` closes the render session the same way."
[job-id error & {:keys [session-id]}]
(request :fail-job
(cond-> {:job-id job-id :error error}
(some? session-id) (assoc :session-id session-id))))

38
exporter/src/app/consumer/config.cljs
View File

@ -1,38 +0,0 @@
;; 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.consumer.config
"The knobs of the consumer: how many jobs run at once and which
queue they come from. Read live, so a long-lived process obeys a
configuration change on the next poll."
(:require
[app.config :as cf]
[cljs.core :as c]))
(def queue-name
"The queue this worker consumes: the one the `:export-assets` job-def
routes its jobs to through `::jobs/queue-name`."
"exporter")
(defn concurrency
"K pollers: each one owns its Redis connection, and the blocking
connection is the semaphore of the slot, so K is the whole concurrency
of the process. At least one: a worker role with zero pollers is a
misconfiguration, not a rest.
Takes the configured value as an argument, so the tests do not
journey through the global config; the zero-arity reads it live."
([]
(concurrency (c/get cf/config :exporter-worker-concurrency)))
([value]
(max 1 (if (number? value) value 2))))
(defn queue-key
"The Redis list the dispatcher pushes this queue's payloads through:
`penpot.worker.queue:<tenant>:<queue>`."
([] (queue-key (cf/get :tenant)))
([tenant]
(str "penpot.worker.queue:" tenant ":" queue-name)))

396
exporter/src/app/consumer/exports.cljs
View File

@ -1,396 +0,0 @@
;; 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.consumer.exports
"The runner of the `:export-assets` job.
Runs one export end to end: the render plan of
`app.consumer.plan` (the name transducers and the partitioning that
the export surfaces always kept), the pdf assembly of the frames
run, the beats shaped by the progress contract (`:preparing`,
`:rendering`, `:packaging`, with the `objects` and `pages` counters
of every partition) and one settle: a `complete-job` multipart call
that stores the artifact and closes the session the backend minted
in the same step. The render runs as the job's owner through the
session `create-job-session` opened.
Cancellation arrives through the beats: a `skip` answer from
`report-job-progress` says the job can no longer hear the worker
(cancelled, aborted, settled). Between units of work the runner
raises, the same `:job-cancelled` the legacy surfaces raised; inside
a render mid-Skia, the watchdog fires the cancel port the wasm pool
already serves (terminate of the leased thread).
The run never rejects on an export failure: whatever goes wrong
reaches the backend as `fail-job` (with the session id, so the render
session does not outlive the settle). Only bugs of this process
reject."
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.uuid :as uuid]
[app.consumer.api :as api]
[app.consumer.plan :as plan]
[app.handlers.resources :as rsc]
[app.jobs :as jobs]
[app.jobs.utils :as job.utils]
[app.renderer :as rd]
[app.util.shell :as sh]
[cuerdas.core :as str]
[promesa.core :as p]))
(def ^:private report-throttle-ms 250)
(def ^:private watchdog-interval-ms 1000)
;; ---- PROGRESS AND CANCEL (the milestones of the contract)
(defn- start-beats
"The reporter of one run's beats.
The beat reports the stage and the counters and asks the backend to
go on; a `skip` answer means nobody is listening anymore — the job
was cancelled or settled elsewhere — and the export must stop: the
reporter fires `on-cancel` once (what terminates the render worker
the run holds mid-Skia; the thread itself does not listen, only the
terminate does) and returns the answer, so the runner sees it at the
next unit of work and raises.
Between forced beats the reporter throttles the way the legacy export
did, since hundreds of objects would otherwise be hundreds of HTTP
calls for information nobody reads at that resolution. An errored
beat answers `run`: the export itself must not fail because the beat
could not fly, and the backend that is unreachable has the lease to
decide what happens to the row."
[job-id on-cancel]
(let [last-beat (atom 0)
last (atom nil)
terminated (atom false)
check (fn [answer]
(when (= :skip (:action answer))
(when (compare-and-set! terminated false true)
(l/info :hint "job cancelled by backend"
:job-id (str job-id))
(on-cancel)))
answer)
report (fn [stage counters]
(->> (api/report-job-progress job-id
{:stage stage
:counters counters})
(p/merr (fn [cause]
(l/warn :hint "beat failed to land"
:job-id (str job-id)
:cause cause)
(p/resolved {:action :run})))
(p/fmap check)))
beat (fn [stage counters & {:keys [force?]}]
(let [now (js/Date.now)
now? (or force?
(>= (- now @last-beat) report-throttle-ms))]
(if now?
(do (reset! last-beat now)
(reset! last {:stage stage :counters counters})
(report stage counters))
(p/resolved {:action :run :throttled? true}))))]
{:beat beat :last last}))
;; ---- THE WATCHDOG
(defn- with-watchdog
"The forced beats of one run: one every `watchdog-interval-ms`, and
they repeat the last report the run made, so a cancellation that
lands mid-render (no object landing, no unit of work ending) is seen
within that interval. `stop` clears it once the run settles."
[beat last]
(let [timer (js/setInterval
#(beat (:stage @last) (:counters @last) :force? true)
watchdog-interval-ms)]
(fn stop [] (js/clearInterval timer))))
(defn- counter
"One counter of the vocabulary: `kind` is `objects` or `pages`."
[kind current total]
{kind {:current current :total total}})
;; ---- THE PARAMS
(defn- frame-item?
"The frames export names pages of a file without a `type`: the pdf
of their pages. A shape item always names its type."
[item]
(nil? (:type item)))
(defn- ->uuid
"One id of the claim into what the renderer wants: the claim carries
the job row JSON, every id a string, while the render spec only
takes uuid objects. Values that already are uuids (tests, callers in
process) pass through."
[v]
(if (string? v) (uuid/uuid v) v))
(defn- normalize-items
"The items the claim delivered are the plain JSON the job row holds:
the type arrives as text and the renderer dispatches on the keywords
the legacy surface received; every id arrives as text and the render
spec only takes uuid objects. The frames items are pages, not typed
shapes: they name the pdf of a page each."
[items]
(->> items
(mapv (fn [item]
(cond-> item
(string? (:type item)) (update :type keyword)
(string? (:file-id item)) (update :file-id ->uuid)
(string? (:page-id item)) (update :page-id ->uuid)
(string? (:object-id item)) (update :object-id ->uuid)
(string? (:share-id item)) (update :share-id ->uuid)
(nil? (:type item)) (assoc :type :pdf :scale 1 :suffix ""))))))
(defn- make-plan
"The render plan the legacy handlers prepare: the same transducers of
names and partition size they served the old surface with, the same
`single?` rule (one prepared export with one object, not forced),
and the artifact the whole run fills."
[job-id token {:keys [exports force-multiple name skip-children is-wasm]}]
(let [items (normalize-items exports)
frames? (boolean (every? frame-item? items))
prepared (plan/prepare-exports items token is-wasm)
single? (and (not frames?)
(not (true? force-multiple))
(= 1 (count prepared))
(= 1 (count (-> prepared first :objects))))
kind (cond
single? (-> prepared first :type)
frames? :pdf
:else :zip)]
{:frames? frames?
:single? single?
:job-id (->uuid job-id)
:prepared prepared
:total (plan/count-objects prepared)
:skip-children skip-children
:is-wasm (boolean is-wasm)
:counter-kind (if frames? :pages :objects)
:resource (rsc/create kind
(or name (-> prepared first :name)))}))
;; ---- THE CANCEL CHECK
(defn- check-cancelled
"The local arm of the cancel: the watchdog's terminate already died
the in-flight thread; the units of work that follow check the flag
and unwind without rendering anything else. The backend's row is
already terminal, so the settle below only reports what happened."
[cancelled]
(when @cancelled
(ex/raise :type :internal
:code :job-cancelled
:hint "export job was cancelled")))
;; ---- THE RUNNERS
(defn- check-beat
"A forced beat after a unit of work: a `skip` there is a cancelled
job, the same exception the legacy surfaces raised, so everything
below unwinds."
[answer]
(when (= :skip (:action answer))
(ex/raise :type :internal
:code :job-cancelled
:hint "export job was cancelled"))
answer)
(defn- run-single
"One render, one object: the artifact IS the object, moved into the
resource path the multipart settle will name."
[beat plan]
(let [{:keys [job-id resource counter-kind]} plan
export (-> plan :prepared first)
object (atom nil)]
(job.utils/track job-id (:path resource))
(p/let [beat-one (beat :rendering (counter counter-kind 0 1) :force? true)
_ (check-beat beat-one)
_ (rd/render (assoc export
:job-id job-id
:skip-children (:skip-children plan))
(fn [obj]
(reset! object obj)
(job.utils/track job-id (:path obj))))
_ (sh/move (:path @object) (:path resource))
beat-end (beat :packaging (counter counter-kind 1 1) :force? true)
_ (check-beat beat-end)]
resource)))
(defn- run-multiple
"The multi-object render: every prepared export renders with the same
on-object callback, appending each object to the zip as it lands, and
the progress counts what has landed so far. Any zipping error
surfaces after the renders, so the failures of the writer do not
compete with the ones of the render."
[beat cancelled plan]
(let [{:keys [job-id resource prepared total counter-kind]} plan
failure (volatile! nil)
rendered (volatile! 0)
zip (rsc/create-zip :resource resource
:on-error (fn [cause] (vreset! failure cause))
:on-progress (fn [_] nil))
append (fn [{:keys [filename path]}]
(check-cancelled cancelled)
(job.utils/track job-id path)
(vswap! rendered inc)
(beat :rendering
(counter counter-kind @rendered total))
(rsc/add-to-zip zip path
(str/replace filename
plan/sanitize-file-regex
"_")))]
(p/let [beat-one (beat :rendering (counter counter-kind 0 total) :force? true)
_ (check-beat beat-one)
_ (rd/with-scope prepared
(fn [scoped-render]
(p/all (map (fn [export]
(scoped-render
(assoc export :job-id job-id)
append))
prepared))))
error (if-let [cause @failure]
(p/rejected cause)
(rsc/close-zip zip))
_ (do error)
beat-end (beat :packaging (counter counter-kind total total) :force? true)
_ (check-beat beat-end)]
resource)))
(defn- join-pdf
"The pages render one file per page; `pdfunite` stitches one pdf out
of them all, the way the legacy export did."
[job-id file-id paths]
(let [path (job.utils/track job-id
(sh/tempfile :prefix (str/concat "penpot.pdfunite." file-id ".")
:suffix ".pdf"))]
(p/let [_ (sh/run-cmd "pdfunite" (into [] (concat (vec paths) [path])))]
path)))
(defn- run-frames
"The frames render: a file per page, joined into the pdf of the file
once every page has landed."
[beat cancelled plan]
(let [{:keys [job-id resource prepared total]} plan
file-id (-> prepared first :file-id)
paths (volatile! [])
rendered (volatile! 0)
on-object (fn [{:keys [path]}]
(check-cancelled cancelled)
(job.utils/track job-id path)
(vswap! paths conj path)
(vswap! rendered inc)
(beat :rendering
(counter :pages @rendered total)))]
(p/let [beat-one (beat :rendering (counter :pages 0 total) :force? true)
_ (check-beat beat-one)
_ (rd/with-scope prepared
(fn [scoped-render]
(p/all (map (fn [export]
(scoped-render
(assoc export :job-id job-id
:is-wasm (:is-wasm plan))
on-object))
prepared))))
joined (join-pdf job-id file-id @paths)
_ (sh/move joined (:path resource))
beat-end (beat :packaging (counter :pages total total) :force? true)
_ (check-beat beat-end)]
resource)))
(defn- run-prepared
[beat cancelled plan]
(cond
(:single? plan) (run-single beat plan)
(:frames? plan) (run-frames beat cancelled plan)
:else (run-multiple beat cancelled plan)))
;; ---- THE SETTLE
(defn- failure-report
"The error shape the backend stores for `job.error`: type and code
keywords, hint the human message. A cause that is not a penpot error
becomes an internal one, with only its message as the hint."
[cause]
(let [data (ex-data cause)]
{:type (or (:type data) :internal)
:code (or (:code data) :export-failed)
:hint (or (:hint data) (ex-message cause) "export failed")}))
(defn cancelled?
"Whether `cause` ends a run the user asked to end: a cancelled
export is a normal ending, reported and logged as one, never as a
failure with a trace."
[cause]
(= :job-cancelled (:code (ex-data cause))))
(defn- settle-failure
"Settles the job as failed, after releasing the temp files the run
owns. The settle never rejects: if the failure cannot reach the
backend, the row keeps running until the lease GC turns it `aborted`,
which is the honest state for a worker that cannot talk."
[job-id session cause]
(p/do
(job.utils/release job-id)
(->> (api/fail-job job-id (failure-report cause)
:session-id (some-> @session :session-id))
(p/merr (fn [settle-cause]
(l/warn :hint "unable to settle the failed job"
:job-id job-id :cause settle-cause))))))
(defn run-export
[{:keys [job-id]} params]
(let [session (atom nil)
cancelled (atom false)
;; the watchdog outlives the scope that starts it, so its
;; stopper travels in this atom: a run that ends badly stops
;; beating too, or its interval would knock on a dead job
;; forever, one HTTP call a second that only ever answers skip
stop-watchdog (atom nil)
_ (jobs/register job-id)
stop-cmd (fn []
(reset! cancelled true)
;; the hard-cancel of the render the run holds: the
;; `renderer.wasm/with-scope` of the in-flight render
;; registered a terminate callback for this job
(jobs/mark-cancelled job-id))]
(p/catch
(p/let [beats (start-beats job-id stop-cmd)
beat (:beat beats)
_ (reset! stop-watchdog (with-watchdog beat (:last beats)))
;; the first breath right after the claim, before the
;; session roundtrip: the widget moves from queued to
;; exporting on it, and a cancel that landed meanwhile
;; raises here instead of after wasted work
_ (check-beat (beat :preparing {} :force? true))
session' (api/create-job-session job-id)
_ (reset! session session')
token (:session-token session')
_ (l/info :hint "render session minted"
:job-id (str job-id))
plan (make-plan job-id token params)
resource (run-prepared beat cancelled plan)
_ (@stop-watchdog)
artifact {:path (str (:path resource))
:filename (:filename resource)
:mtype (:mtype resource)}
_ (api/complete-job-with-artifact
{:job-id job-id :session-id (:session-id session')}
artifact)
_ (job.utils/release job-id)
_ (l/info :hint "export job settled" :job-id (str job-id)
:outcome "completed")]
nil)
(fn [cause]
(when-let [stop @stop-watchdog] (stop))
(if (cancelled? cause)
(l/info :hint "export job cancelled" :job-id (str job-id))
(l/error :hint "export job failed" :job-id (str job-id) :cause cause))
(settle-failure job-id session cause)))))

91
exporter/src/app/consumer/plan.cljs
View File

@ -1,91 +0,0 @@
;; 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.consumer.plan
"The render plan of an assets run.
The items the backend froze in the job become the renders this
process runs: file names built once and kept free of duplicates, then
grouped by scale and type, one render per group on the headless
engines and one DOM page per partition of fifty on the browser
engines. `app.consumer.exports` runs whatever this namespace plans,
and this namespace only plans."
(:require
[app.common.data :as d]
[app.renderer :as rd]
[app.util.mime :as mime]
[cuerdas.core :as str]))
;; Regex to clean namefiles
(def sanitize-file-regex #"[\\/:*?\"<>|]")
(defn count-objects
[exports]
(reduce + 0 (map (comp count :objects) exports)))
(defn- assoc-file-name
"A transducer that assocs a candidate filename and avoid duplicates"
[]
(letfn [(find-candidate [params used]
(loop [index 0]
(let [candidate (str (:name params)
(:suffix params "")
(when (pos? index)
(str/concat "-" (inc index)))
(mime/get-extension (:type params)))]
(if (contains? used candidate)
(recur (inc index))
candidate))))]
(fn [rf]
(let [used (volatile! #{})]
(fn
([] (rf))
([result] (rf result))
([result params]
(let [candidate (find-candidate params @used)
params (assoc params :filename candidate)]
(vswap! used conj candidate)
(rf result params))))))))
(def ^:const ^:private
default-partition-size 50)
(defn prepare-exports
[exports token is-wasm]
(letfn [(process-group [[part1 :as group]]
;; Browser path renders one DOM page per partition; headless WASM
;; takes the whole group in one render.
(if (rd/headless? {:is-wasm is-wasm :type (:type part1)})
[(build-render group)]
(sequence (comp (partition-all default-partition-size)
(map build-render))
group)))
(build-render [[part1 :as part]]
(cond-> {:file-id (:file-id part1)
:page-id (:page-id part1)
:name (:name part1)
:token token
:type (:type part1)
:scale (:scale part1)
:objects (mapv part-entry->object part)}
;; a nil share-id is not an absent one for the render
;; spec: only name it when the item came through one
(some? (:share-id part1)) (assoc :share-id (:share-id part1))))
(part-entry->object [entry]
{:id (:object-id entry)
:filename (:filename entry)
:name (:name entry)
:suffix (:suffix entry)})]
(let [xform (comp
(map #(assoc % :token token))
(assoc-file-name))]
(->> (sequence xform exports)
(d/group-by (juxt :scale :type))
(map second)
(into [] (mapcat process-group))))))

141
exporter/src/app/consumer/worker.cljs
View File

@ -1,141 +0,0 @@
;; 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.consumer.worker
"The consumer of the backend `:exporter` queue.
K pollers run in parallel, each one owning its Redis connection: the
blocking BLPOP of a poller holds that connection for the whole wait,
and the poller does not come back to the queue until the job it
claimed has settled, so the connection is both the semaphore of the
slot and the backpressure — nothing the queue receives can appear
twice taken, and no process ever runs more exports than it has
connections.
The dispatcher pushes `[job-id, scheduled-at]` as JSON into
`penpot.worker.queue:<tenant>:exporter`. Corrupt payloads are logged
and dropped; a Redis hiccup is a lost turn, not a lost job: the
poller waits a bit and pops again (what was already delivered is
claimed, and the loop does not stop the process)."
(:require
["ioredis" :as redis]
[app.common.logging :as l]
[app.config :as cf]
[app.consumer.api :as api]
[app.consumer.config :as ccfg]
[app.consumer.exports :as exports]
[promesa.core :as p]))
(def ^:private poll-timeout-s 5)
(def ^:private reconnect-delay-ms 1000)
(defonce ^:private pollers (atom {}))
(defn- queue-key
"The list the backend dispatcher pushes to."
[]
(ccfg/queue-key))
(defn- connect
"One Redis connection of one poller. ioredis reconnects on its own
strategy, so a fallen Redis comes back with this process doing
nothing but wait (and the failed pop comes right after)."
[]
(new redis/default (cf/get :redis-uri)))
;; ---- THE QUEUE
(defn read-payload
"The JSON payload of the dispatcher: `job-id` and the `scheduled-at`
of the row when it was pushed. Anything else is a corrupt payload:
none, and the caller drops it."
[payload]
(try
(let [[job-id scheduled-at] (js->clj (js/JSON.parse payload))]
{:job-id job-id :scheduled-at scheduled-at})
(catch :default cause
(l/warn :hint "corrupt queue payload dropped"
:payload (str payload) :cause cause)
nil)))
(defn process
"One payload of the queue: claim the job, and when the backend gives
it to this poller, run the export to its settle. `skip` means
something else won it (or it is gone): the payload is dropped, with
the state the backend says."
[{:keys [job-id scheduled-at]}]
(p/let [answer (api/claim-job job-id scheduled-at)]
(if (= :skip (:action answer))
(l/info :hint "skipping job" :job-id (str job-id)
:name (:name answer) :status (:status answer))
(p/do
(l/info :hint "running job" :job-id (str job-id) :name (:name answer))
(exports/run-export {:job-id job-id} (:params answer))
(l/info :hint "job settled" :job-id (str job-id))))))
;; ---- THE POLLER
(defn poll-once
"One turn: pop the queue, claim what came, and wait for the settle.
An empty pop and a dropped payload both resolve; a claimed job is
awaited the whole run."
[conn key on-payload]
(p/let [answer (.blpop ^js conn key poll-timeout-s)
payload (second answer)
claim (when (some? payload) (read-payload payload))
settled (when (some? claim) (on-payload claim))]
settled))
(defn- poll-loop
"The wait of one poller, turn after turn, for the life of the
process. A failed turn (Redis down, a bug) is logged, never allowed
to end the loop; a delay keeps the retry from spinning while the
connection rebuilds."
[conn key on-payload]
(p/loop []
(->> (poll-once conn key on-payload)
(p/merr (fn [cause]
(l/error :hint "poller turn failed" :key key :cause cause)
(p/delay reconnect-delay-ms)))
(p/fmap (fn [_] (p/recur))))))
(defn- redis-host
"The host of `:redis-uri`, for the boot log. Host only: a URI can
carry credentials and those never reach a log line."
[]
(try
(.-host (js/URL. (cf/get :redis-uri)))
(catch :default _ "?")))
;; ---- THE START
(defn start
"Launches `K` pollers, one connection each. The worker cleans the
temp files a previous process left behind at the same moment: a
crashed worker owns nothing of its crash."
[]
(let [key (queue-key)
k (ccfg/concurrency)]
;; Where this process points, said once at boot: a worker that
;; cannot reach its backends fails every turn with a network error,
;; and the curing question is always "where was it looking".
;; Host only, never credentials.
(l/info :hint "worker started" :pollers k :queue key
:redis-host (redis-host) :backend (str (cf/get-internal-uri)))
(doseq [i (range k)]
(let [conn (connect)]
(swap! pollers assoc i conn)
(l/info :hint "poller started" :id i :key key)
(poll-loop conn key process)))))
(defn stop
"Ends the pollers, closing their connections. The job that got orphan
in a settle goes one row further to the next poller; no state hides
in this process."
[]
(doseq [conn (vals @pollers)]
(.quit ^js conn))
(reset! pollers {}))

114
exporter/src/app/jobs.cljs
View File

@ -1,114 +0,0 @@
;; 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
"The local arm of the job life this process runs.
The durable row of a job is the backend's business: the worker claims
it, beats against it and settles it through the management API. This
namespace keeps only the runtime bits that cannot live in a row -- the
cancel callbacks that terminate a render worker, the cancel signal
shared with that render worker, and the flag the parts of a run read
between renders -- keyed by the job id of the claimed job."
(:require
[app.common.logging :as l]
[app.common.time :as ct]))
(def ^:private terminal-states #{"ended" "error" "cancelled"})
(defonce ^:private registry (atom {}))
(defn- now-ms
[]
(inst-ms (ct/now)))
(defn- runtime
[job-id]
(get @registry (str job-id)))
(defn terminal?
[job]
(contains? terminal-states (:state job)))
(defn cancelled?
"True when the job has been marked cancelled in this process. The
check between objects reads it; inside a render the thread reads the
signal instead."
[job-id]
(boolean (:cancelled? (runtime job-id))))
(defn cancel-signal
"Int32Array over a SharedArrayBuffer, readable from a worker thread: 0 while
the job is live, 1 once it has been cancelled. Nil once the job has been
released -- writing the signal back would leave an entry for a settled job in
the registry that nothing would ever remove."
[job-id]
(let [k (str job-id)]
(when-let [rt (get @registry k)]
(or (:cancel-signal rt)
(let [signal (js/Int32Array. (js/SharedArrayBuffer. 4))]
(swap! registry update k (fn [rt] (some-> rt (assoc :cancel-signal signal))))
(when (cancelled? job-id)
(js/Atomics.store signal 0 1))
signal)))))
(defn on-cancel
"Registers a callback used to abort the job's in-flight work (terminating a
render worker). A job fans out over several renders, so callbacks
accumulate. One registered for a job that already settled is dropped: keeping
it would revive that job's registry entry for good."
[job-id f]
(swap! registry update (str job-id)
(fn [rt] (some-> rt (update :cancel-fns (fnil conj []) f)))))
(defn release
"Drops the local runtime entry once the job settled. The row stays in
the backend until it is read once more or expires."
[job-id]
(swap! registry dissoc (str job-id)))
(defn register
"The runtime record of a job this process runs. The local cancel arm
reads it (`mark-cancelled`), so the in-flight render of a claimed job
is terminable without the jobs substrate: the row is the backend's
business, this record is only what a terminate needs."
[job-id & {:keys [total]}]
(swap! registry assoc (str job-id)
{:job {:id job-id :state "running" :total total}
:cancelled? false}))
(defn- check-cancel-callback
[job-id f]
(try
(f)
(catch :default cause
(l/warn :hint "error on job cancel callback" :job-id (str job-id) :cause cause))))
(defn mark-cancelled
"Signals one job of this process as cancelled: raises the cancel flag
(the check between objects sees it), marks the local record terminal
(the row of the job is already terminal in the backend), arms the
shared-array signal (the wasm worker sees it inside a render) and
runs the cancel callbacks (the terminate of the render worker). The
mark happens before the callbacks run: one of them releases the job,
and a second mark for the same job must change nothing.
A job this process does not own, or a settled one, is a no-op."
[job-id]
(let [k (str job-id)
rt (get @registry k)]
(when-let [_job (and rt (:job rt))]
(when-not (terminal? (:job rt))
(let [callbacks (:cancel-fns rt)]
(swap! registry update k
(fn [e] (some-> e
(assoc :cancelled? true)
(update :job assoc :state "cancelled" :ended-at (now-ms)))))
(when-let [signal (:cancel-signal (get @registry k))]
(js/Atomics.store signal 0 1))
(doseq [f callbacks]
(check-cancel-callback job-id f)))
true))))

83
exporter/src/app/jobs/utils.cljs
View File

@ -1,83 +0,0 @@
;; 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.utils
"Temp file ownership for export jobs.
Temp files used to be cleaned only by the per-file timer in `app.util.shell`,
an hour after creation and lost entirely on restart. Here each job owns the
paths it creates, so they are dropped as soon as it settles and whatever a
crash left behind is cleaned at boot."
(:require
["node:fs/promises" :as fsp]
["node:path" :as path]
[app.common.logging :as l]
[app.config :as cf]
[app.util.shell :as sh]
[cuerdas.core :as str]
[promesa.core :as p]))
(def ^:private managed-prefix "penpot.")
(defonce ^:private tracked (atom {}))
(defn track
"Registers `path` as owned by `job-id`, so it is removed when the job settles."
[job-id path]
(when (and job-id path)
(swap! tracked update (str job-id) (fnil conj #{}) path))
path)
(defn- remove-path
[path]
(->> (p/do (fsp/rm path #js {:recursive true :force true}))
(p/merr (fn [cause]
(l/warn :hint "unable to remove job temp file" :path path :cause cause)
(p/resolved nil)))))
(defn release
"Removes every file the job owns. Called once the job reached a terminal
state and its result has already been uploaded, so nothing else reads them."
[job-id]
(let [k (str job-id)
paths (get @tracked k)]
(swap! tracked dissoc k)
(if (seq paths)
(->> (map remove-path paths)
(p/all)
(p/fmap (fn [_]
(l/dbg :hint "released job temp files" :job-id k :count (count paths))
nil)))
(p/resolved nil))))
(defn clean-orphans
"Removes managed temp files older than the job TTL. They can only be leftovers
of a previous process: every live one belongs to a job of this process.
Runs once at boot; nothing here needs initializing."
[]
(let [max-age (* 1000 (cf/get :exporter-job-ttl 3600))
now (js/Date.now)]
(->> (p/do (fsp/readdir sh/tmpdir))
(p/mcat (fn [entries]
(->> (filter #(str/starts-with? % managed-prefix) entries)
(map (fn [entry]
(let [fpath (path/join sh/tmpdir entry)]
(->> (p/do (fsp/stat fpath))
(p/mcat (fn [^js stat]
(if (> (- now (inst-ms (.-mtime stat))) max-age)
(->> (remove-path fpath)
(p/fmap (constantly 1)))
(p/resolved 0))))
(p/merr (fn [_] (p/resolved 0)))))))
(p/all))))
(p/fmap (fn [results]
(let [removed (reduce + 0 results)]
(when (pos? removed)
(l/info :hint "removed orphaned export temp files" :count removed))
removed)))
(p/merr (fn [cause]
(l/warn :hint "temp file cleanup failed" :cause cause)
(p/resolved 0))))))

79
exporter/src/app/renderer.cljs
View File

@ -1,79 +0,0 @@
;; 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.renderer
"Common renderer interface."
(:require
[app.common.logging :as l]
[app.common.spec :as us]
[app.renderer.bitmap :as rb]
[app.renderer.pdf :as rp]
[app.renderer.svg :as rs]
[app.renderer.wasm :as rw]
[cljs.spec.alpha :as s]))
(s/def ::name ::us/string)
(s/def ::suffix ::us/string)
(s/def ::type #{:png :jpeg :webp :pdf :svg})
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::share-id ::us/uuid)
(s/def ::scale ::us/number)
(s/def ::token ::us/string)
(s/def ::filename ::us/string)
(s/def ::is-wasm ::us/boolean)
(s/def ::job-id ::us/uuid)
(s/def ::object
(s/keys :req-un [::id ::name ::suffix ::filename]
:opt-un [::share-id]))
(s/def ::objects
(s/coll-of ::object :min-count 1))
(s/def ::render-params
(s/keys :req-un [::file-id ::page-id ::scale ::token ::type ::objects]
:opt-un [::is-wasm ::job-id]))
(defn headless?
"Whether `params` renders with render-wasm rather than a browser."
[{:keys [is-wasm]}]
(boolean is-wasm))
(defn render
[{:keys [type is-wasm] :as params} on-object]
(us/verify ::render-params params)
(us/verify fn? on-object)
(let [headless? (headless? params)]
(when is-wasm
(l/info :hint "render"
:type type
:backend (if headless? "wasm" "browser")))
(if headless?
(rw/render params on-object)
(case type
:png (rb/render params on-object)
:jpeg (rb/render params on-object)
:webp (rb/render params on-object)
:pdf (rp/render params on-object)
:svg (rs/render params on-object)))))
(defn with-scope
"Runs `f`, a fn of a render fn with the same signature as `render`. Exports
that render headless share one worker for the whole call instead of acquiring
one per render; the browser backend keeps rendering them in parallel."
[exports f]
(if (some headless? exports)
(rw/with-scope (:job-id (first exports))
(fn [render-leased]
(f (fn [params on-object]
(us/verify ::render-params params)
(us/verify fn? on-object)
(if (headless? params)
(render-leased params on-object)
(render params on-object))))))
(f render)))

67
exporter/src/app/renderer/bitmap.cljs
View File

@ -1,67 +0,0 @@
;; 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.renderer.bitmap
"A bitmap renderer."
(:require
[app.browser :as bw]
[app.common.logging :as l]
[app.common.uri :as u]
[app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cuerdas.core :as str]
[promesa.core :as p]))
(defn render
[{:keys [file-id page-id share-id token scale type objects skip-children] :as params} on-object]
(letfn [(prepare-options [uri]
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent})
(render-object [page {:keys [id] :as object}]
(p/let [path (sh/tempfile :prefix "penpot.tmp.bitmap." :suffix (mime/get-extension type))
node (bw/select page (str/concat "#screenshot-" id))]
(bw/wait-for node)
(case type
:png (bw/screenshot node {:omit-background? true :type type :path path})
:jpeg (bw/screenshot node {:omit-background? false :type type :path path})
:webp (p/let [png-path (sh/tempfile :prefix "penpot.tmp.bitmap." :suffix ".png")]
;; playwright only supports jpg and png, we need to convert it afterwards
(bw/screenshot node {:omit-background? true :type :png :path png-path})
(sh/run-cmd "convert" png-path "-quality" "100" (str "WEBP:" path))))
(on-object (assoc object :path path))))
(render [uri page]
(l/info :uri uri)
(p/do
;; navigate to the page and perform basic setup
(bw/nav page (str uri))
(bw/sleep page 1000) ; the good old fix with sleep
(bw/wait-for-fonts page)
(bw/eval page (js* "() => document.body.style.background = 'transparent'"))
;; take the screnshot of requested objects, one by one
(p/run (partial render-object page) objects)
nil))]
(p/let [params {:file-id file-id
:page-id page-id
:share-id share-id
:object-id (mapv :id objects)
:route "objects"
:skip-children skip-children}
uri (-> (cf/get-internal-uri)
(u/ensure-path-slash)
(u/join "render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec (prepare-options uri) (partial render uri)))))

83
exporter/src/app/renderer/pdf.cljs
View File

@ -1,83 +0,0 @@
;; 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.renderer.pdf
"A pdf renderer."
(:require
[app.browser :as bw]
[app.common.data.macros :as dm]
[app.common.logging :as l]
[app.common.uri :as u]
[app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[promesa.core :as p]))
(defn render
[{:keys [file-id page-id share-id token scale type objects] :as params} on-object]
(letfn [(prepare-options [uri]
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent})
(prepare-uri [base-uri object-id]
(let [params {:file-id file-id
:page-id page-id
:share-id share-id
:object-id object-id
:route "objects"}]
(-> base-uri
(u/join "render.html")
(assoc :query (u/map->query-string params)))))
(sync-page-size [dom]
(bw/eval dom
(fn [elem]
;; IMPORTANT: No CLJS runtime allowed. Use only JS
;; primitives. This runs in a context without access to
;; cljs.core. Avoid any functions that transpile to
;; cljs.core/* calls, as they will break in the browser
;; runtime.
(let [width (.getAttribute ^js elem "width")
height (.getAttribute ^js elem "height")
style-node (let [node (.createElement js/document "style")]
(.appendChild (.-head js/document) node)
node)]
(set! (.-textContent style-node)
(dm/str "@page { size: " width "px " height "px; margin: 0; }\n"
"html, body, #app { margin: 0; padding: 0; width: " width "px; height: " height "px; overflow: visible; }"))))))
(render-object [page base-uri {:keys [id] :as object}]
(p/let [uri (prepare-uri base-uri id)
path (sh/tempfile :prefix "penpot.tmp.pdf." :suffix (mime/get-extension type))]
(l/info :uri uri)
(bw/nav page uri)
(p/let [dom (bw/select page (dm/str "#screenshot-" id))]
(bw/wait-for dom)
(sync-page-size dom)
(bw/screenshot dom {:full-page? true})
(bw/sleep page 2000) ; the good old fix with sleep
(bw/wait-for-fonts page)
(bw/pdf page {:path path})
path)))
(render [base-uri page]
(p/loop [objects (seq objects)]
(when-let [object (first objects)]
(p/let [path (render-object page base-uri object)]
(on-object (assoc object :path path))
(p/recur (rest objects))))))]
(let [base-uri (-> (cf/get-internal-uri)
(u/ensure-path-slash))]
(bw/exec (prepare-options base-uri)
(partial render base-uri)))))

356
exporter/src/app/renderer/svg.cljs
View File

@ -1,356 +0,0 @@
;; 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.renderer.svg
(:require
["@penpot/svgo" :as svgo]
["xml-js" :as xml]
[app.browser :as bw]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.types.color :as ctc]
[app.common.uri :as u]
[app.config :as cf]
[app.renderer.svg-gradient :as svg-gradient]
[app.util.mime :as mime]
[app.util.shell :as sh]
[clojure.walk :as walk]
[cuerdas.core :as str]
[promesa.core :as p]))
(l/set-level! :trace)
(defn- xml->clj
[data]
(js->clj (xml/xml2js data)))
(defn- clj->xml
[data]
(xml/js2xml (clj->js data)))
(defn ^boolean element?
[item]
(and (map? item)
(= "element" (get item "type"))))
(defn ^boolean group-element?
[item]
(and (element? item)
(= "g" (get item "name"))))
(defn ^boolean shape-element?
[item]
(and (element? item)
(str/starts-with? (get-in item ["attributes" "id"]) "shape-")))
(defn ^boolean foreign-object-element?
[item]
(and (element? item)
(= "foreignObject" (get item "name"))))
(defn ^boolean empty-defs-element?
[item]
(and (= (get item "name") "defs")
(nil? (get item "attributes"))
(nil? (get item "elements"))))
(defn ^boolean empty-path-element?
[item]
(and (= (get item "name") "path")
(let [d (get-in item ["attributes" "d"])]
(or (str/blank? d)
(nil? d)
(str/empty? d)))))
(defn flatten-toplevel-svg-elements
"Flattens XML data structure if two nested top-side SVG elements found."
[item]
(if (and (= "svg" (get-in item ["elements" 0 "name"]))
(= "svg" (get-in item ["elements" 0 "elements" 0 "name"])))
(update-in item ["elements" 0] assoc "elements" (get-in item ["elements" 0 "elements" 0 "elements"]))
item))
(defn replace-text-nodes
"Function responsible of replace the foreignObject elements on the
provided XML with the previously rasterized PATH's."
[xmldata nodes]
(letfn [(replace-fobject [item]
(if (foreign-object-element? item)
(let [id (get-in item ["attributes" "id"])
node (get nodes id)]
(if node
(:svgdata node)
item))
item))
(process-element [item xform]
(d/update-when item "elements" #(into [] xform %)))]
(let [xform (comp (remove empty-defs-element?)
(remove empty-path-element?)
(map replace-fobject))]
(->> xmldata
(xml->clj)
(flatten-toplevel-svg-elements)
(walk/prewalk (fn [item]
(cond-> item
(element? item)
(process-element xform))))
(clj->xml)))))
(defn parse-viewbox
"Parses viewBox string into width & height map."
[data]
(let [[width height] (->> (str/split data #"\s+")
(drop 2)
(map d/parse-double))]
{:width width
:height height}))
(defn- replace-internal-uris
"Replaces internal-uri references with public-uri in SVG output.
This ensures that font URLs and other resource references in the
exported SVG use the public-facing URI accessible to end users."
[svg-content]
(let [internal-uri (str (cf/get-internal-uri))
public-uri (str (cf/get :public-uri))]
(if (and (not= internal-uri public-uri)
(str/includes? svg-content internal-uri))
(str/replace svg-content internal-uri public-uri)
svg-content)))
(defn render
[{:keys [page-id file-id share-id objects token scale type]} on-object]
(letfn [(convert-to-ppm [pngpath]
(let [ppmpath (str/concat pngpath "origin.ppm")]
(l/trace :fn :convert-to-ppm :path ppmpath)
(-> (sh/run-cmd "convert" pngpath ppmpath)
(p/then (constantly ppmpath)))))
(trace-color-mask [pbmpath]
(l/trace :fn :trace-color-mask :pbmpath pbmpath)
(let [svgpath (str/concat pbmpath ".svg")]
(-> (sh/run-cmd "potrace" "--flat" "-b" "svg" pbmpath "-o" svgpath)
(p/then (constantly svgpath)))))
(generate-color-layer [ppmpath color]
(when-not (ctc/hex-color-string? color)
(ex/raise :type :validation
:code :invalid-color
:hint (str "invalid hex color: " color)))
(l/trace :fn :generate-color-layer :ppmpath ppmpath :color color)
(let [pbmpath (str/concat ppmpath ".mask-" (subs color 1) ".pbm")]
(-> (sh/run-cmd "ppmcolormask" color ppmpath)
(p/then (fn [stdout]
(-> (sh/write-file pbmpath stdout)
(p/then (constantly pbmpath)))))
(p/then trace-color-mask)
(p/then sh/read-file)
(p/then (fn [data]
(p/let [data (xml->clj data)
data (get-in data ["elements" 1])]
{:color color
:svgdata data}))))))
(set-path-color [id color mapping node]
(let [color-mapping (get mapping color)]
(cond
(and (some? color-mapping)
(= "transparent" (get color-mapping "type")))
(update node "attributes" assoc
"fill" (get color-mapping "hex")
"fill-opacity" (get color-mapping "opacity"))
(and (some? color-mapping)
(= "gradient" (get color-mapping "type")))
(update node "attributes" assoc
"fill" (str "url(#gradient-" id "-" (subs color 1) ")"))
:else
(update node "attributes" assoc "fill" color))))
(get-gradients [id mapping]
(->> mapping
(filter (fn [[_color data]]
(= (get data "type") "gradient")))
(mapv (partial svg-gradient/data->gradient-def id))))
(join-color-layers [{:keys [id x y width height mapping] :as node} layers]
(l/trace :fn :join-color-layers :mapping mapping)
(loop [result (-> (:svgdata (first layers))
(assoc "elements" []))
layers (seq layers)]
(if-let [{:keys [color svgdata]} (first layers)]
(recur (->> (get svgdata "elements")
(filter #(= (get % "name") "g"))
(map (partial set-path-color id color mapping))
(update result "elements" into))
(rest layers))
;; Now we have the result containing the svgdata of a
;; SVG with all text layers. Now we need to transform
;; this SVG to G (Group) and remove unnecessary metadata
;; objects.
(let [vbox (-> (get-in result ["attributes" "viewBox"])
(parse-viewbox))
transform (str/fmt "translate(%s, %s) scale(%s, %s)" x y
(/ width (:width vbox))
(/ height (:height vbox)))
gradient-defs (get-gradients id mapping)
elements
(->> (get result "elements")
(mapv (fn [group]
(let [paths (get group "elements")]
(if (= 1 (count paths))
(let [path (first paths)]
(update path "attributes"
(fn [attrs]
(-> attrs
(d/merge (get group "attributes"))
(update "transform" #(str transform " " %))))))
(update-in group ["attributes" "transform"] #(str transform " " %)))))))
elements (cond->> elements
(seq gradient-defs)
(into [{"type" "element" "name" "defs" "attributes" {}
"elements" gradient-defs}]))]
(-> result
(assoc "name" "g")
(assoc "attributes" {})
(assoc "elements" elements))))))
(convert-to-svg [ppmpath {:keys [colors] :as node}]
(l/trace :fn :convert-to-svg :ppmpath ppmpath :colors colors)
(-> (p/all (map (partial generate-color-layer ppmpath) colors))
(p/then (partial join-color-layers node))))
(trace-node [{:keys [data] :as node}]
(l/trace :fn :trace-node)
(p/let [pngpath (sh/tempfile :prefix "penpot.tmp.render.svg.parse."
:suffix ".origin.png")
_ (sh/write-file pngpath data)
ppmpath (convert-to-ppm pngpath)
svgdata (convert-to-svg ppmpath node)]
(-> node
(dissoc :data)
(assoc :svgdata svgdata))))
(extract-element-attrs [^js element]
(let [^js attrs (.. element -attributes)
^js colors (.. element -dataset -colors)
^js mapping (.. element -dataset -mapping)]
#js {:id (.. attrs -id -value)
:x (.. attrs -x -value)
:y (.. attrs -y -value)
:width (.. attrs -width -value)
:height (.. attrs -height -value)
:colors (.split colors ",")
:mapping (js/JSON.parse mapping)}))
(extract-single-node [[shot node]]
(l/trace :fn :extract-single-node)
(p/let [attrs (bw/eval node extract-element-attrs)]
{:id (unchecked-get attrs "id")
:x (unchecked-get attrs "x")
:y (unchecked-get attrs "y")
:width (unchecked-get attrs "width")
:height (unchecked-get attrs "height")
:colors (vec (unchecked-get attrs "colors"))
:mapping (js->clj (unchecked-get attrs "mapping"))
:data shot}))
(resolve-text-node [page node]
(p/let [attrs (bw/eval node extract-element-attrs)
id (unchecked-get attrs "id")
text-node (bw/select page (str "#screenshot-text-" id " foreignObject"))
shot (bw/screenshot text-node {:omit-background? true :type "png"})]
[shot node]))
(extract-txt-node [page item]
(-> (p/resolved item)
(p/then (partial resolve-text-node page))
(p/then extract-single-node)
(p/then trace-node)))
(extract-txt-nodes [page {:keys [id] :as objects}]
(l/trace :fn :process-text-nodes)
(-> (bw/select-all page (str/concat "#screenshot-" id " foreignObject"))
(p/then (fn [nodes] (p/all (map (partial extract-txt-node page) nodes))))
(p/then (fn [nodes] (d/index-by :id nodes)))))
(extract-svg [page {:keys [id] :as object}]
(let [node (bw/select page (str/concat "#screenshot-" id))]
(bw/wait-for node)
(bw/eval node (fn [elem] (.-outerHTML ^js elem)))))
(prepare-options [uri]
#js {:screen #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:viewport #js {:width bw/default-viewport-width
:height bw/default-viewport-height}
:locale "en-US"
:storageState #js {:cookies (bw/create-cookies uri {:token token})}
:deviceScaleFactor scale
:userAgent bw/default-user-agent})
(render-object [page {:keys [id] :as object}]
(p/let [path (sh/tempfile :prefix "penpot.tmp.render.svg." :suffix (mime/get-extension type))
node (bw/select page (str/concat "#screenshot-" id))]
(bw/wait-for node)
(p/let [xmldata (extract-svg page object)
txtdata (extract-txt-nodes page object)
result (replace-text-nodes xmldata txtdata)
;; SVG standard don't allow the entity
;; nbsp. &#160; is equivalent but compatible
;; with SVG.
result (str/replace result "&nbsp;" "&#160;")
result (if (contains? cf/flags :exporter-svgo)
(svgo/optimize result svgo/defaultOptions)
result)
result (replace-internal-uris result)]
;; (println "------- ORIGIN:")
;; (cljs.pprint/pprint (xml->clj xmldata))
;; (println "------- RESULT:")
;; (cljs.pprint/pprint (xml->clj result))
;; (println "-------")
(sh/write-file path result)
(on-object (assoc object :path path))
path)))
(render [uri page]
(l/info :uri uri)
(p/do
;; navigate to the page and perform basic setup
(bw/nav page (str uri))
(bw/sleep page 1000) ; the good old fix with sleep
(bw/wait-for-fonts page)
;; take the screnshot of requested objects, one by one
(p/run (partial render-object page) objects)
nil))]
(p/let [params {:file-id file-id
:page-id page-id
:share-id share-id
:render-embed true
:object-id (mapv :id objects)
:route "objects"}
uri (-> (cf/get-internal-uri)
(u/ensure-path-slash)
(u/join "render.html")
(assoc :query (u/map->query-string params)))]
(bw/exec (prepare-options uri)
(partial render uri)))))

32
exporter/src/app/renderer/svg_gradient.cljs
View File

@ -1,32 +0,0 @@
;; 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.renderer.svg-gradient)
(defn- get-stops
[data]
(->> (get-in data ["gradient" "stops"])
(mapv (fn [stop-data]
{"type" "element"
"name" "stop"
"attributes" {"offset" (get stop-data "offset")
"stop-color" (get stop-data "color")
"stop-opacity" (get stop-data "opacity")}}))))
(defn data->gradient-def
[id [color data]]
(let [id (str "gradient-" id "-" (subs color 1))
gradient-type (get-in data ["gradient" "type"])]
(if (= gradient-type "linear")
{"type" "element"
"name" "linearGradient"
"attributes" {"id" id "x1" "0.5" "y1" "1" "x2" "0.5" "y2" "0"}
"elements" (get-stops data)}
{"type" "element"
"name" "radialGradient"
"attributes" {"id" id "cx" "0.5" "cy" "0.5" "r" "0.5"}
"elements" (get-stops data)})))

50
exporter/src/app/renderer/wasm.cljs
View File

@ -1,50 +0,0 @@
;; 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.renderer.wasm
"Main-thread side of the headless renderer.
Renders run on pooled workers because Skia calls are synchronous and would block
the HTTP server and other exports. Each job keeps one worker for all its renders,
sharing its caches and pool slot."
(:require
[app.jobs :as jobs]
[app.wasm.pool :as pool]
[promesa.core :as p]))
(defn- serializer
"Chains thunks so a job's renders run one at a time on its worker. A failure
is isolated: it doesn't break the chain for the next one."
[]
(let [queue (atom (p/resolved nil))]
(fn [thunk]
(let [result (p/handle @queue (fn [_ _] (thunk)))]
(reset! queue (p/handle result (fn [_ _] nil)))
result))))
(defn with-scope
"Runs `f`, a fn of a 2-arg render fn. Every render goes to the same worker,
one at a time, so the cancel check runs as each render's turn comes up."
[job-id f]
(pool/with-worker
(fn [worker]
(let [chain (serializer)
live (volatile! worker)
signal (when job-id (jobs/cancel-signal job-id))
opts {:cancel-buffer (some-> signal (.-buffer))
:cancelled? (when job-id #(jobs/cancelled? job-id))}]
(when job-id
;; Between objects the worker sees the flag; inside a render only
;; terminating the thread stops it. Cleared on the way out so a later
;; cancel cannot terminate a worker that is by then somebody else's.
(jobs/on-cancel job-id (fn [] (pool/terminate @live))))
(->> (p/do (f (fn [params on-object]
(chain #(pool/render-on worker params on-object opts)))))
(p/fnly (fn [_ _] (vreset! live nil))))))))
(defn render
[params on-object]
(with-scope (:job-id params) (fn [render*] (render* params on-object))))

103
exporter/src/app/util/shell.cljs
View File

@ -1,103 +0,0 @@
;; 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.util.shell
"Shell & FS utilities."
(:require
["node:child_process" :as proc]
["node:fs" :as fs]
["node:path" :as path]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.config :as cf]
[cuerdas.core :as str]
[promesa.core :as p]))
(l/set-level! :trace)
(def ^:const default-deletion-delay
(* 60 60 1)) ;; 1h
(def tmpdir
(let [path (cf/get :tempdir)]
(l/inf :hint "tmptdir setup" :path path)
(when-not (fs/existsSync path)
(fs/mkdirSync path #js {:recursive true}))
path))
(defn schedule-deletion
([path] (schedule-deletion path default-deletion-delay))
([path delay]
(let [remove-path
(fn []
(try
(when (fs/existsSync path)
(fs/rmSync path #js {:recursive true})
(l/trc :hint "tempfile permanently deleted" :path path))
(catch :default cause
(l/err :hint "error on deleting temporal file"
:path path
:cause cause))))
scheduled-at
(-> (ct/now) (ct/plus #js {:seconds delay}))]
(l/trc :hint "schedule tempfile deletion"
:path path
:scheduled-at (ct/format-inst scheduled-at))
(js/setTimeout remove-path (* delay 1000))
path)))
(defn tempfile
[& {:keys [prefix suffix]
:or {prefix "penpot."
suffix ".tmp"}}]
(loop [i 0]
(if (< i 1000)
(let [path (path/join tmpdir (str/concat prefix (uuid/next) "-" i suffix))]
(if (fs/existsSync path)
(recur (inc i))
(schedule-deletion path)))
(ex/raise :type :internal
:code :unable-to-locate-temporal-file
:hint "unable to find a tempfile candidate"))))
(defn move
[origin-path dest-path]
(.rename fs/promises origin-path dest-path))
(defn stat
[path]
(->> (.stat fs/promises path)
(p/fmap (fn [data]
{:path path
:created-at (inst-ms (.-ctime ^js data))
:size (.-size data)}))
(p/merr (fn [_cause]
(p/resolved nil)))))
(defn write-file
[fpath content]
(.writeFile fs/promises fpath content))
(defn read-file
[fpath]
(.readFile fs/promises fpath))
(defn run-cmd
[cmd & args]
(p/create
(fn [resolve reject]
(l/trace :fn :run-cmd :cmd cmd :args args)
(proc/execFile cmd (clj->js args) #js {:encoding "buffer"}
(fn [error stdout _stderr]
;; (l/trace :fn :run-cmd :stdout stdout)
(if error
(reject error)
(resolve stdout)))))))

238
exporter/src/app/wasm/pool.cljs
View File

@ -1,238 +0,0 @@
;; 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.wasm.pool
"Pool of headless render workers.
Mirrors `app.browser`: a `generic-pool` whose objects are `worker_threads`
instead of browsers, so acquisition and eviction behave the same way for both
render backends. A worker is expensive to build (it boots its own render-wasm
module), hence the pooling.
Acquisition is not capped: the admission scheduler is the backpressure, and
the idle watchdog guarantees a wedged worker gives its slot back.
Workers run the same bundle as the main thread; `exporter.main/start` branches on
`isMainThread`. There is always at least one worker, since a headless render
has nowhere else to go."
(:require
["generic-pool" :as gp]
["node:path" :as path]
["node:process" :as proc]
["node:worker_threads" :as wt]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.transit :as t]
[app.config :as cf]
[app.consumer.config :as ccfg]
[promesa.core :as p]))
(l/set-level! :info)
(defonce pool (atom nil))
(defonce ^:private worker-id (atom 0))
(def ^:private ready-timeout-ms 60000)
(defn- idle-timeout-ms
"How long a render may go silent before the worker is presumed wedged. Reset
on every message, so a long export keeps its worker as long as it keeps
reporting objects; only a thread stuck inside Skia, which reports nothing and
emits no `exit`, runs it out."
[]
(* 1000 (cf/get :wasm-worker-idle-timeout 300)))
(defn- worker-script
[]
(path/resolve (aget (.-argv proc/default) 1)))
(defn- create-worker
[]
(p/create
(fn [resolve reject]
(let [script (worker-script)
id (swap! worker-id inc)
worker (new wt/Worker script)
timer (js/setTimeout
(fn []
(l/error :hint "render worker did not become ready" :worker-id id)
(.terminate ^js worker)
(reject (ex/error :type :internal
:code :worker-not-ready
:hint "render worker did not become ready")))
ready-timeout-ms)]
(unchecked-set worker "__id" id)
(unchecked-set worker "__alive" true)
(.on ^js worker "error"
(fn [cause]
(l/error :hint "render worker error" :worker-id id :cause cause)
(unchecked-set worker "__alive" false)
;; A worker that dies while booting has to fail its own creation;
;; rejecting after `resolve` is a no-op, so this is safe for the
;; errors that arrive once it is already in the pool.
(js/clearTimeout timer)
(reject cause)))
(.on ^js worker "exit"
(fn [code]
(l/info :hint "render worker exited" :worker-id id :code code)
(unchecked-set worker "__alive" false)))
;; Not `.once`: a stray message before the handshake would consume the
;; listener and leave the worker hanging until `ready-timeout-ms`.
(letfn [(on-ready [data]
(when (= "ready" (unchecked-get data "type"))
(js/clearTimeout timer)
(.off ^js worker "message" on-ready)
(l/info :origin "factory" :action "create" :worker-id id)
(resolve worker)))]
(.on ^js worker "message" on-ready))))))
(def ^:private worker-pool-factory
#js {:create create-worker
:destroy (fn [worker]
(l/info :origin "factory" :action "destroy"
:worker-id (unchecked-get worker "__id"))
(.terminate ^js worker))
:validate (fn [worker]
(p/resolved (true? (unchecked-get worker "__alive"))))})
(defn capacity
"How many renders can run at once: the pool holds as many render
workers as concurrent jobs the process runs, which is what the
pollers count. Clamped rather than rejected: a bad value should not
stop the exporter from booting, and a headless render has no other
backend to fall back to."
[]
(max 1 (ccfg/concurrency)))
(defn init
[]
(let [max-workers (capacity)
opts #js {:max max-workers
:min (min max-workers (cf/get :wasm-worker-pool-min 1))
:testOnBorrow true
:evictionRunIntervalMillis 30000
:numTestsPerEvictionRun 2
:idleTimeoutMillis 300000}]
(l/info :hint "initializing render worker pool" :opts opts)
(reset! pool (gp/createPool worker-pool-factory opts))
(p/resolved nil)))
(defn stop
[]
(when-let [instance @pool]
(l/info :hint "finalizing render worker pool")
(reset! pool nil)
(p/do
(.drain ^js instance)
(.clear ^js instance))))
(defn- run-on-worker
"Settles when the worker reports the render finished, failed, or the thread
went away. That last case matters: a terminated worker (how a cancel stops a
render mid-Skia) emits `exit` and never `error`, and a promise left pending
there would keep its pool slot borrowed for the life of the process."
[^js worker params cancel-buffer on-object]
(p/create
(fn [resolve reject]
(let [timer (volatile! nil)]
(letfn [(disarm []
(when-let [t @timer]
(js/clearTimeout t)
(vreset! timer nil)))
(rearm []
(disarm)
(vreset! timer (js/setTimeout
(fn []
(l/error :hint "render worker went silent, terminating"
:worker-id (unchecked-get worker "__id"))
(cleanup)
;; Terminating is what frees the pool slot:
;; the `exit` it raises has no listener left.
(unchecked-set worker "__alive" false)
(.terminate ^js worker)
(reject (ex/error :type :internal
:code :render-timeout
:hint "render worker stopped responding")))
(idle-timeout-ms))))
(cleanup []
(disarm)
(.off worker "message" on-message)
(.off worker "error" on-error)
(.off worker "exit" on-exit))
(on-error [cause]
(cleanup)
(reject cause))
(on-exit [code]
(cleanup)
(reject (ex/error :type :internal
:code :worker-exited
:hint (str "render worker exited with code " code))))
(on-message [data]
(rearm)
(case (unchecked-get data "type")
;; A failure while the main thread handles the object (moving
;; the file, appending to the zip) has to end the render too,
;; or nothing ever settles this promise.
"object" (try
(on-object (t/decode-str (unchecked-get data "payload")))
(catch :default cause
(cleanup)
(reject cause)))
"done" (do (cleanup) (resolve nil))
"error" (do (cleanup)
(reject (ex/error :type :internal
:code (or (some-> (unchecked-get data "code") keyword)
:wasm-render-error)
:hint (unchecked-get data "message"))))
nil))]
(.on worker "message" on-message)
(.once worker "error" on-error)
(.once worker "exit" on-exit)
(rearm)
(.postMessage worker #js {:type "render"
:params (t/encode-str params)
:cancel cancel-buffer}))))))
(defn with-worker
"Acquires one worker for the whole of `f`, a fn of that worker."
[f]
(let [instance @pool]
(->> (p/do (.acquire ^js instance))
(p/mcat (fn [worker]
(->> (p/do (f worker))
(p/fmap (fn [result]
(.release ^js instance worker)
result))
(p/merr (fn [cause]
;; The module may be aborted or mid-write, and
;; a terminated worker cannot be reused.
(-> (p/do (.destroy ^js instance worker))
(p/handle (fn [_ _] (p/rejected cause))))))))))))
(defn render-on
"Renders `params` on an already acquired worker."
[worker params on-object {:keys [cancel-buffer cancelled?]}]
(if (and cancelled? (cancelled?))
(p/rejected (ex/error :type :internal
:code :job-cancelled
:hint "export job was cancelled"))
(run-on-worker worker params cancel-buffer on-object)))
(defn terminate
[^js worker]
(when worker
(unchecked-set worker "__alive" false)
(.terminate worker)))

502
exporter/src/app/wasm/render.cljs
View File

@ -1,502 +0,0 @@
;; 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.wasm.render
"Headless render pipeline: renders exports with the render-wasm Skia pipeline,
with no browser and no WebGL.
Per request: fetch scene (get-page RPC) -> serialize -> provision fonts and
images -> relayout text with the real fonts -> render each object.
This runs inside a render worker (`app.wasm.worker`), one WASM design state
per worker, so the synchronous Skia calls never block the process that serves
HTTP. `app.renderer.wasm` is the main-thread side that drives it.
Moved here verbatim from `app.renderer.wasm`; git reads it as a new file only
because that namespace still exists as the proxy. Reviewable as a rename:
`git show <base>:exporter/src/app/renderer/wasm.cljs | diff -u - <this file>`.
Handles png/jpeg/webp (Skia encodes all three), pdf and svg."
(:require
["node:fs" :as fs]
["undici" :as http]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.fonts :as cfnt]
;; Required for side effects: these register the transit read handlers and
;; deftype impls the `get-page` response is decoded into.
[app.common.geom.matrix]
[app.common.geom.point]
[app.common.geom.rect]
[app.common.logging :as l]
[app.common.transit :as t]
[app.common.types.fills.impl]
[app.common.types.objects-map]
[app.common.types.path.impl]
[app.common.types.shape]
[app.common.types.shape.images :as images]
[app.common.uri :as u]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.util.mime :as mime]
[app.util.shell :as sh]
[app.wasm :as wasm]
[app.wasm.serialize :as serialize]
[cuerdas.core :as str]
[promesa.core :as p]))
;; --- module lifecycle (one shared, lazily-initialized instance)
(defonce ^:private module* (atom nil))
(defn- ensure-module
[]
(or @module*
(reset! module* (wasm/init))))
;; --- backend endpoints
;;
;; Every fetch targets the internal endpoint (falling back to public-uri),
;; in a deployment the exporter reaches the backend over the container network
(defn- internal-uri
"Absolute URI for `path` on the internal (backend) endpoint."
[path]
(-> (cf/get-internal-uri)
(u/ensure-path-slash)
(u/join path)
(str)))
(defn- public-uri
"Absolute URI for `path` on the public endpoint. Whoever opens an exported SVG
resolves its `@font-face` sources, so those cannot use the internal endpoint."
[path]
(-> (cf/get :public-uri)
(u/ensure-path-slash)
(u/join path)
(str)))
(defn- error-detail
"Node's fetch reports every transport failure as a bare `TypeError: fetch
failed`; the actual reason (TLS rejection, DNS, ECONNREFUSED) is buried in a
nested `cause` chain that the logger does not print. Flattens the chain into
one readable string."
[cause]
(->> (iterate (fn [^js e] (unchecked-get e "cause")) cause)
(take-while some?)
(take 5)
(map (fn [^js e]
(let [code (unchecked-get e "code")
msg (or (unchecked-get e "message") (str e))]
(if code (str code ": " msg) msg))))
(str/join " <- ")))
(defn- fetch
"`undici/fetch` that fails with an ex-info carrying the target uri and the
unwrapped cause chain, so a failed request says what actually went wrong and
against which endpoint."
[uri opts]
(->> (p/do (http/fetch uri opts))
(p/merr (fn [cause]
(p/rejected (ex-info "http fetch failed"
{:uri uri :detail (error-detail cause)}
cause))))))
(defn- explain
"Log-friendly reason for `cause`: the detail `fetch` already attached, or a
freshly unwrapped chain for anything else (WASM aborts, decode errors)."
[cause]
(or (:detail (ex-data cause))
(error-detail cause)))
(defn- rpc-headers
"Auth headers for backend RPC calls (management key + bearer)."
[token]
#js {"Content-Type" "application/transit+json"
"X-Shared-Key" (str "exporter " cf/management-key)
"Authorization" (str "Bearer " token)})
(defn- asset-headers
"Auth headers for `/assets/*`. Cookie, not Bearer: those endpoints redirect to
a presigned S3/minio URL, and a Bearer header makes S3 400 (\"multiple
authentication types\")."
[token]
#js {"X-Shared-Key" (str "exporter " cf/management-key)
"Cookie" (str "auth-token=" token)})
;; --- shape bundle fetch (backend RPC)
(defn- fetch-objects
"Fetches the exported roots and their children from the backend via the
`get-page` RPC (`:object-id`, as the browser render path does), using the
same auth the exporter uses elsewhere (management key + bearer)."
[{:keys [file-id page-id share-id token objects]}]
(let [headers (rpc-headers token)
root-ids (into #{} (map :id) objects)
body (t/encode-str (cond-> {:file-id file-id
:page-id page-id}
(seq root-ids) (assoc :object-id root-ids)
share-id (assoc :share-id share-id)))
uri (internal-uri "api/rpc/command/get-page")]
(l/dbg :hint "wasm render: get-page"
:uri uri
:file-id (str file-id)
:page-id (str page-id)
:roots (count root-ids))
(->> (fetch uri #js {:method "POST" :headers headers :body body})
(p/mcat (fn [^js resp]
(if (= 200 (.-status resp))
(.text resp)
(->> (.text resp)
(p/mcat (fn [resp-body]
(l/error :hint "wasm render: get-page failed"
:uri uri
:status (.-status resp)
:body resp-body)
(p/rejected (ex-info "get-page failed"
{:status (.-status resp)
:body resp-body}))))))))
(p/fmap t/decode-str)
(p/fmap :objects))))
;; --- font resolution
;;
;; The text serializer keeps each font's real uuid, so `wasm/fonts-for-shape`
;; reports it. Custom (team) fonts resolve through the file's font variants,
;; google fonts through the shared `app.common.fonts` catalog; builtin
;; fonts through its bundled family + the frontend's static `/fonts/`.
(defn- fetch-font-variants
"Team (custom) font variants for the file, or nil — a failure here degrades
to fallback fonts, it does not fail the export."
[{:keys [file-id share-id token]}]
(let [headers (rpc-headers token)
body (t/encode-str (cond-> {:file-id file-id}
share-id (assoc :share-id share-id)))
uri (internal-uri "api/rpc/command/get-font-variants")]
(->> (fetch uri #js {:method "POST" :headers headers :body body})
(p/mcat (fn [^js resp]
(if (= 200 (.-status resp))
(.text resp)
(p/resolved nil))))
(p/fmap (fn [s] (when s (t/decode-str s))))
(p/merr (fn [cause]
(l/warn :hint "wasm render: get-font-variants failed"
:uri uri :detail (explain cause) :cause cause)
(p/resolved nil))))))
(defn- fetch-ttf-bytes
"Downloads a TTF, returning a promise of an ArrayBuffer (or nil). A failure
here degrades to fallback fonts, it does not fail the export."
([uri] (fetch-ttf-bytes uri #js {:method "GET"}))
([uri opts]
(->> (fetch uri opts)
(p/mcat (fn [^js resp]
(if (= 200 (.-status resp))
(.arrayBuffer resp)
(p/resolved nil))))
(p/merr (fn [cause]
(l/warn :hint "wasm render: font fetch failed"
:uri uri :detail (explain cause) :cause cause)
(p/resolved nil))))))
;; TTF bytes cached for the process lifetime, keyed by whatever identifies the
;; variant (a gfont id+weight+style, a builtin file name).
(defonce ^:private font-bytes* (atom {}))
(defn- cached-ttf-bytes
[cache-key fetch-fn]
(if-let [bytes (get @font-bytes* cache-key)]
(p/resolved bytes)
(->> (fetch-fn)
(p/fmap (fn [buf]
(when buf (swap! font-bytes* assoc cache-key buf))
buf)))))
(defn- fetch-asset-bytes
[asset-id {:keys [token]}]
(fetch-ttf-bytes (internal-uri (str "assets/by-id/" asset-id))
#js {:method "GET" :headers (asset-headers token)}))
(defn- fetch-gfont-bytes
[ttf-url]
(fetch-ttf-bytes (cfnt/gstatic->proxy-url ttf-url (internal-uri "internal/gfonts/font"))))
(defn- fetch-builtin-font-bytes
[ttf-file]
(cached-ttf-bytes ttf-file #(fetch-ttf-bytes (internal-uri (str "fonts/" ttf-file)))))
(defn- family-uuid
[id]
(uuid/from-unsigned-parts (aget id 0) (aget id 1) (aget id 2) (aget id 3)))
(defn- find-variant
"Custom variant for a family: uuid+weight+style first, degrading to
uuid+weight then uuid."
[variants font-uuid weight style]
(let [style-str (if (zero? style) "normal" "italic")]
(or (d/seek (fn [v] (and (= (:font-id v) font-uuid)
(= (:font-weight v) weight)
(= (name (:font-style v)) style-str)))
variants)
(d/seek (fn [v] (and (= (:font-id v) font-uuid)
(= (:font-weight v) weight)))
variants)
(d/seek (fn [v] (= (:font-id v) font-uuid)) variants))))
(defn- make-resolve-font
"Builds a `resolve-font` fn (family map -> promise of TTF bytes). Custom
variants first; the bundled fonts for `uuid/zero`, which is what
`font-id->uuid` maps every builtin family to; google catalog otherwise."
[variants params]
(fn [{:keys [id weight style]}]
(let [font-uuid (family-uuid id)
variant (find-variant variants font-uuid weight style)]
(cond
(:ttf-file-id variant)
(fetch-asset-bytes (:ttf-file-id variant) params)
(= uuid/zero font-uuid)
(fetch-builtin-font-bytes (cfnt/resolve-ttf-file weight style))
:else
(if-let [gurl (cfnt/resolve-ttf-url font-uuid weight style)]
(fetch-gfont-bytes gurl)
(p/resolved nil))))))
(defn- make-font-url
"Builds a `font-url` fn (family map -> public URL of its TTF), the same
sources `make-resolve-font` downloads from but addressed publicly. The SVG
export emits one `@font-face` per family from these."
[variants]
(fn [{:keys [id weight style]}]
(let [font-uuid (family-uuid id)
variant (find-variant variants font-uuid weight style)]
(cond
(:ttf-file-id variant)
(public-uri (str "assets/by-id/" (:ttf-file-id variant)))
(= uuid/zero font-uuid)
(public-uri (str "fonts/" (cfnt/resolve-ttf-file weight style)))
:else
(some-> (cfnt/resolve-ttf-url font-uuid weight style)
(cfnt/gstatic->proxy-url (public-uri "internal/gfonts/font")))))))
;; --- fallback fonts (emoji + per-script noto fonts)
;;
;; Emoji and non-latin scripts render through fallback families, not through
;; any span's font family, so `wasm/fonts-for-shape` never reports them and the
;; provisioning above never uploads them. Must run per request, since
;; `clear-fonts` empties the store; the TTF bytes stay cached per process.
(defn- scene-fallback-fonts
"Fallback font descriptors needed by the scene's text. Deduped because
several languages map to one noto family and provisioning is concurrent —
otherwise they all miss the byte cache at once and refetch the same TTF."
[scene]
(let [texts (for [shape (vals scene)
:when (= :text (:type shape))
node (or (some->> (:content shape) (tree-seq :children :children)) [])
:let [text (:text node)]
:when (string? text)]
text)
emoji? (boolean (some cfnt/contains-emoji? texts))
langs (reduce cfnt/collect-used-languages #{} texts)]
(distinct
(cond-> (cfnt/add-noto-fonts [] langs)
emoji? (cfnt/add-emoji-font)))))
(defn- fetch-fallback-font-bytes
"Downloads one fallback font's TTF. Cached by the whole variant, not just
`font-id`: `resolve-ttf-url` picks a different TTF per weight/style, so a
font-id-only key would serve the first downloaded variant for every other one."
[{:keys [font-id weight style]}]
(if-let [ttf-url (some-> (cfnt/gfont-id->uuid font-id) (cfnt/resolve-ttf-url weight style))]
(cached-ttf-bytes [font-id weight style] #(fetch-gfont-bytes ttf-url))
(p/resolved nil)))
(defn- provision-fallback-fonts
[scene]
(->> (scene-fallback-fonts scene)
(map (fn [{:keys [font-id weight style is-emoji is-fallback] :as font}]
(if-let [font-uuid (cfnt/gfont-id->uuid font-id)]
(->> (fetch-fallback-font-bytes font)
(p/fmap (fn [buf]
(if buf
(wasm/store-font {:id (uuid/get-u32 font-uuid)
:weight weight
:style style
:emoji? (boolean is-emoji)
:fallback? (boolean is-fallback)}
buf)
(l/warn :hint "wasm render: fallback font unavailable"
:font-id font-id)))))
(p/resolved nil))))
(p/all)))
;; --- image resolution
;;
;; Image fills reference file-media ids; the encoded bytes go straight to
;; `_store_image` (Skia decodes, no WebGL), keyed by media uuid so this happens
;; once per request rather than per rendered object.
(defn- fetch-file-media-bytes
"Downloads an image fill's encoded bytes by file-media id."
[media-id {:keys [token]}]
(let [headers (asset-headers token)
uri (internal-uri (str "assets/by-file-media-id/" media-id))]
(->> (fetch uri #js {:method "GET" :headers headers})
(p/mcat (fn [^js resp]
(if (= 200 (.-status resp))
(.arrayBuffer resp)
(do
(l/warn :hint "wasm render: image fetch non-200"
:media-id (str media-id)
:uri uri
:status (.-status resp))
(p/resolved nil)))))
(p/merr (fn [cause]
(l/warn :hint "wasm render: image fetch failed"
:media-id (str media-id) :uri uri
:detail (explain cause) :cause cause)
(p/resolved nil))))))
(defn- provision-images
"Fetches and stores every image the scene references (shape, stroke and
text-span fills, enumerated by `app.common.types.shape.images`). Unlike fonts,
the image store is not reset per request, so already-held images are skipped
and repeated exports of a file reuse them.
Always registers a public media URL for each id so SVG export can emit linked
`<image href>` even when the encoded bytes were already cached."
[scene params]
(let [all-ids (images/scene-image-ids scene)
new-ids (remove wasm/image-cached? all-ids)]
(l/dbg :hint "wasm render: provisioning images"
:total (count all-ids)
:cached (- (count all-ids) (count new-ids)))
(doseq [image-id all-ids]
(wasm/store-image-url image-id (public-uri (str "assets/by-file-media-id/" image-id))))
(->> new-ids
(map (fn [image-id]
(->> (fetch-file-media-bytes image-id params)
(p/fmap (fn [buf]
(if buf
(do
(l/dbg :hint "wasm render: image stored"
:media-id (str image-id)
:bytes (.-byteLength ^js buf))
(wasm/store-image image-id buf))
(l/warn :hint "wasm render: image unavailable"
:media-id (str image-id))))))))
(p/all))))
(defn- relayout-text
"Recomputes layout for every text shape, once the real fonts are provisioned
(serialize-time layout used the fallback)."
[scene]
(doseq [shape (vals scene)
:when (= :text (:type shape))]
(wasm/update-text-layout (:id shape))))
;; --- render
(defn- check-cancelled
"Cancellation is cooperative: a render already inside Skia cannot be
interrupted, so the flag is only observed between objects. Killing a job
mid-object is the caller's job (terminating the worker)."
[{:keys [cancelled?] :as _params}]
(when (and cancelled? (cancelled?))
(ex/raise :type :internal
:code :job-cancelled
:hint "export job was cancelled")))
(defn- render-object-bytes
[type id scale]
(case type
:pdf (let [bytes (wasm/render-shape-pdf id scale)]
(l/dbg :hint "PDF generated via Skia (render-wasm headless)"
:object-id (str id)
:backend "skia-wasm"
:bytes (.-length bytes))
bytes)
:svg (let [bytes (wasm/render-shape-svg id scale)]
(l/dbg :hint "SVG generated via Skia (render-wasm headless)"
:object-id (str id)
:backend "skia-wasm"
:bytes (.-length bytes))
bytes)
(wasm/render-shape-raster id scale type)))
(defn- render*
[{:keys [scale type objects] :as params} on-object]
(l/dbg :hint "wasm render: start"
:type type
:scale scale
:objects (count objects)
:file-id (str (:file-id params))
:page-id (str (:page-id params)))
(->> (ensure-module)
(p/mcat (fn [_] (fetch-objects params)))
(p/mcat (fn [scene]
(l/dbg :hint "wasm render: scene fetched" :shapes (count scene))
(serialize/serialize-scene scene)
(l/dbg :hint "wasm render: scene serialized")
;; So fonts from a previous request don't leak into this one.
(wasm/clear-fonts)
(->> (p/all [(fetch-font-variants params)
(provision-images scene params)
(provision-fallback-fonts scene)])
(p/mcat
(fn [[variants _]]
(let [variants (or variants [])
resolve-font (make-resolve-font variants params)
font-url (make-font-url variants)]
;; Before rendering, so the relayout below sees real
;; font metrics. Deduped across objects: shapes
;; sharing one family download its TTF once.
(wasm/provision-fonts (map :id objects) resolve-font
:font-url font-url))))
(p/mcat
(fn [_]
(relayout-text scene)
(p/run
(fn [{:keys [id] :as object}]
(check-cancelled params)
(let [bytes (render-object-bytes type id scale)
path (sh/tempfile :prefix "penpot.tmp.wasm."
:suffix (mime/get-extension type))]
(l/dbg :hint "wasm render: object rendered"
:object-id (str id) :bytes (.-length bytes))
(fs/writeFileSync path bytes)
;; `on-object` returns a plain value (zip append) or
;; a promise (single export's file move); `p/do`
;; normalizes both to a thenable.
(p/do (on-object (assoc object :path path)))))
objects))))))
(p/fmap (fn [result]
;; After the request, never mid-render, so an image can't
;; disappear under a running export.
(let [evicted (wasm/evict-images (cf/get :wasm-worker-image-cache-size wasm/image-cache-size))]
(when (pos? evicted)
(l/info :hint "wasm render: evicted cached images" :count evicted)))
result))
(p/merr (fn [cause]
(l/error :hint "wasm render: failed"
:detail (explain cause)
:internal-uri (str (cf/get-internal-uri))
:cause cause)
;; A panic can leave the mem buffer allocated or the instance
;; aborted; drop it so the next request rebuilds a fresh one.
(reset! module* nil)
(p/rejected cause)))))
(defn render
"Public entry. Renders every object of `params`, calling `on-object` with
`{:id :filename :path ...}` as each one is written out."
[params on-object]
(render* params on-object))

71
exporter/src/app/wasm/worker.cljs
View File

@ -1,71 +0,0 @@
;; 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.wasm.worker
"Render worker entry point.
Owns one render-wasm module and renders one export request at a time. The
Skia calls are synchronous, so running them here is what lets several exports
progress at once: the main thread keeps serving HTTP, zipping and uploading
while this thread is blocked inside a render.
Messages in: {type: \"render\", params: <transit>, cancel: SharedArrayBuffer}
Messages out: {type: \"ready\"}
{type: \"object\", payload: <transit>} one per rendered object
{type: \"done\"} | {type: \"error\", message, code}"
(:require
["node:worker_threads" :as wt]
[app.common.logging :as l]
[app.common.transit :as t]
[app.wasm.render :as render]
[promesa.core :as p]))
(defn- post
[message]
(.postMessage ^js wt/parentPort message))
(defn- cancelled-fn
[buffer]
(if (some? buffer)
(let [signal (js/Int32Array. buffer)]
(fn [] (pos? (js/Atomics.load signal 0))))
(constantly false)))
(defn- handle-render
[data]
(let [params (-> (unchecked-get data "params")
(t/decode-str)
(assoc :cancelled? (cancelled-fn (unchecked-get data "cancel"))))]
(->> (render/render params
(fn [object]
(post #js {:type "object" :payload (t/encode-str object)})))
(p/fmap (fn [_] (post #js {:type "done"})))
(p/merr (fn [cause]
(l/warn :hint "render worker: request failed" :cause cause)
(post #js {:type "error"
:message (or (ex-message cause) (str cause))
:code (some-> cause ex-data :code name)})
(p/resolved nil))))))
(defn- on-message
[data]
(case (unchecked-get data "type")
"render" (handle-render data)
(l/warn :hint "render worker: unknown message" :type (unchecked-get data "type"))))
(defonce ^:private listening
;; `defonce` survives a hot reload, so a reload does not stack a second
;; listener on the port. The indirection through the var keeps the reloaded
;; `on-message` in play instead of pinning the one captured at boot.
(delay
(.on ^js wt/parentPort "message" (fn [data] (on-message data)))
true))
(defn main
[& _]
@listening
(post #js {:type "ready"})
(l/info :hint "render worker ready"))

2
exporter/src/exporter/browser.cljs
View File

@ -23,7 +23,7 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.util.object :as obj]
[exporter.util.object :as obj]
[exporter.utils.system :as system]))
(l/set-level! :trace)

72
exporter/src/app/config.cljs → exporter/src/exporter/config.cljs
View File

@ -4,13 +4,23 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.config
(ns exporter.config
"The process configuration, read from the environment.
Same shape as the legacy `app.config` it replaces: `PENPOT_`-prefixed
variables become kebab-case keys over the defaults, decoded and
validated against the schema. The one deliberate split: `prepare`
over an explicit env object is pure and throws on invalid input (so
tests exercise it), while only the wiring entry `load-config!` reads
the live environment and exits on it — the process never boots with
a config it cannot derive its management key from."
(:refer-clojure :exclude [get])
(:require
["node:buffer" :as buffer]
["node:crypto" :as crypto]
["node:process" :as process]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.flags :as flags]
[app.common.logging :as l]
[app.common.schema :as sm]
@ -70,12 +80,13 @@
[config]
(flags/parse (:flags config)))
(defn- read-env
[prefix]
(let [env (unchecked-get process "env")
kwd (fn [s] (-> (str/kebab s) (str/keyword)))
prefix (str prefix "_")
len (count prefix)]
(defn read-env
"The `PENPOT_`-prefixed variables of `env` as kebab-case keys, the
rest ignored. Takes the env object explicitly so tests pass a fake."
[env]
(let [prefix "penpot_"
len (count prefix)
kwd (fn [s] (-> (str/kebab s) (str/keyword)))]
(reduce (fn [res key]
(let [val (unchecked-get env key)
key (str/lower key)]
@ -85,22 +96,32 @@
{}
(js/Object.keys env))))
(defn- prepare-config
[]
(let [env (read-env "penpot")
env (d/without-nils env)
data (merge defaults env)
data (decode-config data)]
(defn prepare-config
"Defaults plus `env`, decoded and validated. Throws on invalid input
instead of exiting: only the wiring entry exits, on the live
environment."
[env]
(let [data (-> (merge defaults (d/without-nils (read-env env)))
(decode-config))]
(when-not (valid-config? data)
(let [explain (explain-config data)]
(println (sm/humanize-explain explain))
(process/exit -1)))
(throw (ex/error :type :internal
:code :invalid-config
:hint (sm/humanize-explain (explain-config data)))))
data))
(defn load-config!
"The live environment as validated config. Exits the process on
invalid input: without a secret there is no management key to derive,
so there is nothing to boot."
[]
(try
(prepare-config (unchecked-get process "env"))
(catch :default cause
(println (ex-message cause))
(process/exit -1))))
(def config
(prepare-config))
(load-config!))
(def version
(v/parse "%version%"))
@ -121,11 +142,16 @@
(or (c/get config :internal-uri)
(c/get config :public-uri)))
(defn derive-management-key
"The management key for `secret`: HKDF blake2b512 over \"exporter\",
32 bytes, base64url. Pure so tests pin the formula the backend
derives on its side."
[secret]
(-> (.from buffer/Buffer (crypto/hkdfSync "blake2b512" secret "exporter" "" 32))
(.toString "base64url")))
(def management-key
(let [key (or (c/get config :exporter-shared-key)
(let [secret-key (c/get config :secret-key)
derived-key (crypto/hkdfSync "blake2b512" secret-key, "exporter" "" 32)]
(-> (.from buffer/Buffer derived-key)
(.toString "base64url"))))]
(derive-management-key (c/get config :secret-key)))]
(l/inf :hint "exporter key initialized" :key (d/obfuscate-string key))
key))

33
exporter/src/exporter/consumer.cljs
View File

@ -35,13 +35,13 @@
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.uuid :as uuid]
[app.handlers.resources :as rsc]
[app.jobs.utils :as job.utils]
[cuerdas.core :as str]
[exporter.consumer.api :as api]
[exporter.consumer.plan :as plan]
[exporter.jobs :as jobs]
[exporter.shell :as shell]))
[exporter.resources :as rsc]
[exporter.shell :as shell]
[exporter.tmpdir :as tdir]))
(def ^:private report-throttle-ms 250)
(def ^:private watchdog-interval-ms 1000)
@ -144,7 +144,7 @@
names and partition size they served the old surface with, the same
`single?` rule (one prepared export with one object, not forced),
and the artifact the whole run fills."
[job-id token {:keys [exports kind force-multiple name skip-children is-wasm]}]
[job-id token tmpdir {:keys [exports kind force-multiple name skip-children is-wasm]}]
(let [items (normalize-items exports)
;; declared by the caller, never sniffed: typeless items do not
;; exist on the validated contract, so there is nothing to infer
@ -166,7 +166,8 @@
:skip-children skip-children
:is-wasm (boolean is-wasm)
:counter-kind (if frames? :pages :objects)
:resource (rsc/create artifact-kind
:resource (rsc/create tmpdir
artifact-kind
(or name (-> prepared first :name)))}))
;; ---- THE RUNNERS
@ -189,14 +190,14 @@
(let [{:keys [job-id resource counter-kind]} plan
export (-> plan :prepared first)
object (atom nil)]
(job.utils/track job-id (:path resource))
(tdir/track job-id (:path resource))
(check-beat (await (beat :rendering (counter counter-kind 0 1) :force? true)))
(await (render {:exports [(assoc export
:job-id job-id
:skip-children (:skip-children plan))]
:on-object (fn [obj]
(reset! object obj)
(job.utils/track job-id (:path obj))
(tdir/track job-id (:path obj))
nil)
:check-cancelled check-cancelled}))
(await (shell/move (:path @object) (:path resource)))
@ -218,7 +219,7 @@
:on-progress (fn [_] nil))
append (fn [{:keys [filename path]}]
(check-cancelled)
(job.utils/track job-id path)
(tdir/track job-id path)
(vswap! rendered inc)
(beat :rendering
(counter counter-kind @rendered total))
@ -241,10 +242,10 @@
"The pages render one file per page; `pdfunite` stitches one pdf out
of them all, the way the legacy export did."
[job-id tmpdir file-id paths]
(let [path (job.utils/track job-id
(shell/tempfile tmpdir
:prefix (str/concat "penpot.pdfunite." file-id ".")
:suffix ".pdf"))]
(let [path (tdir/track job-id
(shell/tempfile tmpdir
:prefix (str/concat "penpot.pdfunite." file-id ".")
:suffix ".pdf"))]
(await (shell/run-cmd "pdfunite" (into [] (concat (vec paths) [path]))))
path))
@ -258,7 +259,7 @@
rendered (volatile! 0)
on-object (fn [{:keys [path]}]
(check-cancelled)
(job.utils/track job-id path)
(tdir/track job-id path)
(vswap! paths conj path)
(vswap! rendered inc)
(beat :rendering
@ -307,7 +308,7 @@
backend, the row keeps running until the lease GC turns it `aborted`,
which is the honest state for a worker that cannot talk."
[job-id session cause]
(await (job.utils/release job-id))
(await (tdir/release job-id))
(jobs/release job-id)
(try
(await (api/fail-job job-id (failure-report cause)
@ -341,7 +342,7 @@
(reset! session session')
(l/info :hint "render session minted"
:job-id (str job-id))
(let [plan (make-plan job-id (:session-token session') params)
(let [plan (make-plan job-id (:session-token session') tmpdir params)
resource (await (run-prepared render tmpdir beat check-cancelled plan))]
;; the watchdog outlives the render, so the run stops it on
;; the way out: a run that ends badly stops beating too, or
@ -354,7 +355,7 @@
(await (api/complete-job-with-artifact
{:job-id job-id :session-id (:session-id session')}
artifact))
(await (job.utils/release job-id))
(await (tdir/release job-id))
(jobs/release job-id)
(l/info :hint "export job settled" :job-id (str job-id)
:outcome "completed")

4
exporter/src/exporter/consumer/api.cljs
View File

@ -21,8 +21,8 @@
[app.common.exceptions :as ex]
[app.common.transit :as t]
[app.common.uri :as u]
[app.config :as cf]
[cljs.core :as c]))
[cljs.core :as c]
[exporter.config :as cf]))
(def fetch
"The network entry point of the client: a plain def, redefined by the

4
exporter/src/exporter/consumer/config.cljs
View File

@ -9,8 +9,8 @@
queue they come from. Read live, so a long-lived process obeys a
configuration change on the next poll."
(:require
[app.config :as cf]
[cljs.core :as c]))
[cljs.core :as c]
[exporter.config :as cf]))
(def queue-name
"The queue this worker consumes: the one the `:export-assets` job-def

4
exporter/src/exporter/consumer/plan.cljs
View File

@ -15,9 +15,9 @@
namespace only plans."
(:require
[app.common.data :as d]
[app.util.mime :as mime]
[cuerdas.core :as str]
[exporter.renderer :as renderer]))
[exporter.renderer :as renderer]
[exporter.util.mime :as mime]))
;; Regex to clean namefiles
(def sanitize-file-regex #"[\\/:*?\"<>|]")

8
exporter/src/exporter/consumer/worker.cljs
View File

@ -32,8 +32,7 @@
(:require
["ioredis" :as redis]
[app.common.logging :as l]
[app.config :as cf]
[app.jobs.utils :as job.utils]
[exporter.config :as cf]
[exporter.consumer :as consumer]
[exporter.consumer.api :as api]
[exporter.consumer.config :as ccfg]
@ -114,10 +113,9 @@
(defn ^:async start
"Launches the pollers over the queue and resolves the handle their
`stop` needs. A previous process leaves no temp files behind: the
boot cleans what the crash owned before the first pop."
`stop` needs. The temp area boots clean before the first poller: the
tmpdir service drops what a previous process left on its init."
[{:keys [concurrency queue-key connect] :as cfg}]
(await (job.utils/clean-orphans))
(let [running (atom true)
handle {:running running :conns (atom [])}
on-payload (fn [claim] (process cfg claim))

15
exporter/src/exporter/main.cljs
View File

@ -10,24 +10,24 @@
`stop` and `restart` managing the running system.
Render workers run this same bundle, so the thread decides what gets
booted: one legacy render worker (`app.wasm.worker`, engines stay
untouched), or the system of the main thread. Without the guard a
booted: one render worker (`exporter.wasm.worker`, owning the
headless module), or the system of the main thread. Without the guard a
warmed pool worker would boot pools and pollers of its own and never
post its `ready` handshake."
(:require
["node:process" :as proc]
["node:worker_threads" :as wt]
[app.common.logging :as l]
[app.config :as cf]
[app.wasm.worker :as wasm.worker]
[exporter.browser :as browser]
[exporter.config :as cf]
[exporter.consumer :as-alias consumer]
[exporter.consumer.config :as ccfg]
[exporter.consumer.worker]
[exporter.tmpdir]
[exporter.utils.system :as system]
[exporter.wasm :as-alias wasm]
[exporter.wasm.pool]))
[exporter.wasm.pool]
[exporter.wasm.worker :as wasm.worker]))
(l/setup! {:exporter :info})
@ -43,7 +43,8 @@
{:max (ccfg/concurrency)}
:exporter/tmpdir
{:path (cf/get :tempdir)}
{:path (cf/get :tempdir)
:job-ttl (cf/get :exporter-job-ttl 3600)}
:exporter/renderer
{::browser/pool (system/ref :exporter.browser/pool)
@ -51,6 +52,8 @@
:exporter/tmpdir (system/ref :exporter/tmpdir)
:base-uri (cf/get-internal-uri)
:public-uri (cf/get :public-uri)
:management-key cf/management-key
:image-cache-size (cf/get :wasm-worker-image-cache-size)
:svgo? (contains? cf/flags :exporter-svgo)}
::consumer/worker

19
exporter/src/exporter/renderer.cljs
View File

@ -39,6 +39,7 @@
[app.common.schema :as sm]
[exporter.browser.scope :as bscope]
[exporter.utils.system :as system]
[exporter.wasm.render :as wrender]
[exporter.wasm.scope :as scope]))
(def schema:type
@ -83,6 +84,18 @@
[{:keys [is-wasm]}]
(boolean is-wasm))
(defn- render-env
"The render environment of one batch: internal and public endpoints,
the management key, the temp area and the image cache budget. Read
from the service config (wired from the environment); the worker
thread never resolves any of it itself."
[cfg]
{:internal-uri (:base-uri cfg)
:public-uri (:public-uri cfg)
:management-key (:management-key cfg)
:tmpdir (:exporter/tmpdir cfg)
:image-cache-size (:image-cache-size cfg)})
(defn ^:async render
"Renders every export, firing them all at once: the browser ones
through their own scope, the wasm ones through one leased
@ -93,7 +106,11 @@
(let [cfg (assoc cfg
::on-object on-object
::check-cancelled check-cancelled)
wexports (filter wasm? exports)
;; Everything the worker thread needs beyond the export
;; itself rides in the posted params: the worker reads no
;; config and no globals.
wexports (map #(assoc % ::wrender/env (render-env cfg))
(filter wasm? exports))
bexports (remove wasm? exports)]
(await (js/Promise.all
(cond-> []

4
exporter/src/exporter/renderer/browser.cljs
View File

@ -26,12 +26,12 @@
[app.common.logging :as l]
[app.common.types.color :as ctc]
[app.common.uri :as u]
[app.util.mime :as mime]
[clojure.walk :as walk]
[cuerdas.core :as str]
[exporter.browser :as browser]
[exporter.renderer.svg-gradient :as svg-gradient]
[exporter.shell :as shell]))
[exporter.shell :as shell]
[exporter.util.mime :as mime]))
(l/set-level! :trace)

41
exporter/src/app/handlers/resources.cljs → exporter/src/exporter/resources.cljs
View File

@ -4,32 +4,35 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.handlers.resources
(ns exporter.resources
"The run's local resources: the artifact files the runner parks in
the temp area until the settle moves them into the job's completion,
zipped once a run packs more than one."
the injected temp area until the settle moves them into the job's
completion, zipped once a run packs more than one.
Same operations as the legacy `app.handlers.resources`, adapted:
the temp area arrives injected (no global), and the zip close is
awaited instead of chained. The per-file deletion timers of the old
shell are gone on purpose: the tmpdir registry owns every path and
releases it on the settle."
(:require
["archiver" :as arc]
["node:fs" :as fs]
["node:path" :as path]
[app.common.uuid :as uuid]
[app.util.mime :as mime]
[app.util.shell :as sh]
[cljs.core :as c]
[cuerdas.core :as str]
[promesa.core :as p]))
[exporter.util.mime :as mime]))
(defn- get-path
[type id]
(path/join sh/tmpdir (str/concat "penpot.resource." (c/name type) "." id)))
(defn- resource-path
[tmpdir type id]
(path/join tmpdir (str/concat "penpot.resource." (c/name type) "." id)))
(defn create
"Generates ephimeral resource object."
[type name]
(let [task-id (uuid/next)
path (-> (get-path type task-id)
(sh/schedule-deletion))]
{:path path
"An ephemeral artifact descriptor of `type` named `name`, parked
under the injected `tmpdir`."
[tmpdir type name]
(let [task-id (uuid/next)]
{:path (resource-path tmpdir type task-id)
:mtype (mime/get type)
:name name
:filename (str/concat (str/replace name #"[\\/:*?\"<>|]" "_") (mime/get-extension type))
@ -54,8 +57,8 @@
[zip path name]
(.file ^js zip path #js {:name name}))
(defn close-zip
(defn ^:async close-zip
[zip]
(p/create (fn [resolve]
(.on ^js zip "close" resolve)
(.finalize ^js zip))))
(await (js/Promise. (fn [resolve]
(.on ^js zip "close" (fn [] (resolve nil)))
(.finalize ^js zip)))))

86
exporter/src/exporter/tmpdir.cljs
View File

@ -8,15 +8,93 @@
"The temp-file area as a system component (`:exporter/tmpdir`).
Its config value names the directory (`{:path ...}`, read from the
environment at the wiring layer); booting ensures it exists and the
environment at the wiring layer) plus the age that makes a leftover
an orphan (`:job-ttl`, seconds, same unit as the environment knob);
booting ensures the directory exists and cleans whatever a previous
process left behind, before anything that writes to it boots. The
running instance is the path itself, which renderers and runners
read straight from their config. Fail fast on a blank path instead
of failing the first render that writes. Named for what it owns,
not for the legacy namespace it shadows."
not for the legacy namespace it shadows.
The area also owns what jobs park in it: every path a job tracks is
removed on its release, so temp files die with the settle instead of
an hour later (or never, on a crash)."
(:require
["node:fs/promises" :as fsp]
["node:path" :as path]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[cuerdas.core :as str]
[exporter.shell :as shell]
[exporter.utils.system :as system]))
(def ^:private managed-prefix "penpot.")
(defonce ^:private tracked (atom {}))
(defn track
"Registers `path` as owned by `job-id`, so it is removed when the job
settles. Returns the path, so it wraps the call that creates it."
[job-id path]
(when (and job-id path)
(swap! tracked update (str job-id) (fnil conj #{}) path))
path)
(defn- ^:async remove-path
[path]
(try
(await (fsp/rm path #js {:recursive true :force true}))
(catch :default cause
(l/warn :hint "unable to remove job temp file" :path path :cause cause))))
(defn ^:async release
"Removes every file the job owns. Called once the job reached a
terminal state and its result has already been uploaded, so nothing
else reads them. Unknown jobs resolve at once."
[job-id]
(let [paths (get @tracked (str job-id))]
(swap! tracked dissoc (str job-id))
(when (seq paths)
(await (js/Promise.all (mapv remove-path paths)))
(l/dbg :hint "released job temp files" :job-id (str job-id) :count (count paths)))
nil))
(defn ^:async clean-orphans
"Removes managed temp files older than `job-ttl-s`. They can only be
leftovers of a previous process: every live one belongs to a job of
this process. Resolves the count it removed."
[tmpdir job-ttl-s]
(let [max-age (* 1000 job-ttl-s)
now (js/Date.now)]
(try
(let [entries (await (fsp/readdir tmpdir))
removed (volatile! 0)]
(doseq [entry (filter #(str/starts-with? % managed-prefix) entries)]
(let [fpath (path/join tmpdir entry)]
(try
(let [^js stat (await (fsp/stat fpath))]
(when (> (- now (inst-ms (.-mtime stat))) max-age)
(await (remove-path fpath))
(vswap! removed inc)))
(catch :default _ nil))))
(when (pos? @removed)
(l/info :hint "removed orphaned export temp files" :count @removed))
@removed)
(catch :default cause
(l/warn :hint "temp file cleanup failed" :cause cause)
0))))
(defn- ^:async boot
[path job-ttl]
(let [dir (shell/ensure-dir path)]
(await (clean-orphans dir job-ttl))
dir))
(defmethod system/init-key :exporter/tmpdir
[_ {:keys [path]}]
(shell/ensure-dir path))
[_ {:keys [path job-ttl]}]
(when (nil? job-ttl)
(throw (ex/error :type :assertion
:code :job-ttl-missing
:hint "tmpdir needs :job-ttl (seconds) in its config")))
(boot path job-ttl))

4
exporter/src/app/util/mime.cljs → exporter/src/exporter/util/mime.cljs
View File

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.util.mime
(ns exporter.util.mime
"Mimetype and file extension helpers."
(:refer-clojure :exclude [get])
(:require
@ -29,5 +29,3 @@
:jpeg "image/jpeg"
:png "image/png"
:webp "image/webp"))

2
exporter/src/app/util/object.cljs → exporter/src/exporter/util/object.cljs
View File

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.util.object
(ns exporter.util.object
"A collection of helpers for work with javascript objects."
(:refer-clojure :exclude [set! get get-in merge update clone contains?])
(:require

74
exporter/src/app/wasm.cljs → exporter/src/exporter/wasm.cljs
View File

@ -4,13 +4,14 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.wasm
(ns exporter.wasm
"Headless driver for the render-wasm module under Node: the GPU-free
counterpart of `app.render-wasm.api`. Loads the emscripten artifact, boots it
via `init_headless`, and exposes font provisioning + shape rendering.
Serialization is reused from the portable render-wasm leaves, so this
namespace owns only the Node runtime and the headless render calls.
There are no promesa chains in this namespace.
Requires render-wasm built with `-sENVIRONMENT=web,node`."
(:require
@ -23,10 +24,9 @@
[app.common.render-wasm.serializers :as sr]
[app.common.render-wasm.wasm :as wasm]
[app.common.uuid :as uuid]
;; Required for side effects: binds the generated enums.
[app.wasm.enums]
[cuerdas.core :as str]
[promesa.core :as p]
;; Required for side effects: binds the generated enums.
[exporter.wasm.enums]
[shadow.esm :refer [dynamic-import]]))
(def ^:private default-viewport-width 1920)
@ -56,39 +56,35 @@
;; --- MODULE LIFECYCLE
(defn init
(defn ^:async init
"Loads the render-wasm artifact under Node and boots it headless. Sets the
shared `wasm/internal-module` so the portable serialization leaves work.
Idempotent-ish: callers should hold the returned module."
([] (init default-viewport-width default-viewport-height))
([width height]
(let [dir artifact-dir
js-path (path/resolve dir "render-wasm.js")
wasm-path (path/resolve dir "render-wasm.wasm")
(let [dir artifact-dir
js-path (path/resolve dir "render-wasm.js")
wasm-path (path/resolve dir "render-wasm.wasm")
wasm-bytes (fs/readFileSync wasm-path)]
(l/info :hint "loading render-wasm (headless)" :js js-path)
;; shadow-cljs :esm — use its dynamic-import helper (raw `js/import`
;; compiles to an undefined `import$`).
(->> (dynamic-import (str "file://" js-path))
(p/mcat
(fn [mod]
(let [factory (unchecked-get mod "default")]
(factory
#js {;; Bypass the web fetch loader: instantiate from local bytes.
:instantiateWasm
(fn [imports success]
(-> (js/WebAssembly.instantiate wasm-bytes imports)
(.then (fn [result] (success (.-instance result)))))
#js {})
:locateFile (fn [p] (path/resolve dir p))
:printErr (fn [s] (l/warn :wasm s))}))))
(p/fmap
(fn [module]
(set! wasm/internal-module module)
(h/call module "_init_headless" width height)
(set! wasm/context-initialized? true)
(l/info :hint "render-wasm headless module ready" :width width :height height)
module))))))
(let [mod (await (dynamic-import (str "file://" js-path)))
factory (unchecked-get mod "default")
module (await (factory
#js {;; Bypass the web fetch loader: instantiate from local bytes.
:instantiateWasm
(fn [imports success]
(-> (js/WebAssembly.instantiate wasm-bytes imports)
(.then (fn [result] (success (.-instance result)))))
#js {})
:locateFile (fn [p] (path/resolve dir p))
:printErr (fn [s] (l/warn :wasm s))}))]
(set! wasm/internal-module module)
(h/call module "_init_headless" width height)
(set! wasm/context-initialized? true)
(l/info :hint "render-wasm headless module ready" :width width :height height)
module))))
;; --- FONT PROVISIONING (on demand, mirrors the browser)
@ -245,22 +241,24 @@
[max-bytes]
(h/call wasm/internal-module "_evict_images_to_budget" max-bytes))
(defn provision-fonts
(defn ^:async provision-fonts
"Resolves and uploads every font needed by `shape-ids`, each family fetched
once. `resolve-font` is an injected fn of the family map -> promise of TTF
bytes (or nil to skip); optional `font-url` is a fn of the family map -> the
public URL those bytes came from. This keeps the font *source* (gfonts proxy
/ custom assets / backend) out of the driver."
[shape-ids resolve-font & {:keys [font-url]}]
(->> (fonts-for-shapes shape-ids)
(map (fn [family]
(->> (resolve-font family)
(p/fmap (fn [bytes]
(when bytes
(store-font family bytes)
(when-let [url (when font-url (font-url family))]
(store-font-url family url))))))))
(p/all)))
(let [families (fonts-for-shapes shape-ids)]
(await (js/Promise.all
(mapv (^:async fn [family]
(let [bytes (await (resolve-font family))]
(when bytes
(store-font family bytes)
(when-let [url (when font-url (font-url family))]
(store-font-url family url)))
nil))
families)))
nil))
;; --- RENDER

2
exporter/src/app/wasm/enums.cljs → exporter/src/exporter/wasm/enums.cljs
View File

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.wasm.enums
(ns exporter.wasm.enums
"Binds this build's generated enums into the shared bridge.
`shared.js` is emitted next to this file by `render-wasm/build export` and is

495
exporter/src/exporter/wasm/render.cljs Normal file
View File

@ -0,0 +1,495 @@
;; 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 exporter.wasm.render
"Headless render pipeline: renders exports with the render-wasm Skia pipeline,
with no browser and no WebGL.
Per request: fetch scene (get-page RPC) -> serialize -> provision fonts and
images -> relayout text with the real fonts -> render each object.
This runs inside a render worker (one WASM design state per worker), so the
synchronous Skia calls never block the main thread. Everything the pipeline
needs beyond the export itself travels in `env`
(`:internal-uri`, `:public-uri`, `:management-key`, `:tmpdir`,
`:image-cache-size`): the worker thread reads no config and no globals.
There are no promesa chains in this namespace.
Handles png/jpeg/webp (Skia encodes all three), pdf and svg."
(:require
["node:fs" :as fs]
["undici" :as http]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.fonts :as cfnt]
;; Required for side effects: these register the transit read handlers and
;; deftype impls the `get-page` response is decoded into.
[app.common.geom.matrix]
[app.common.geom.point]
[app.common.geom.rect]
[app.common.logging :as l]
[app.common.transit :as t]
[app.common.types.fills.impl]
[app.common.types.objects-map]
[app.common.types.path.impl]
[app.common.types.shape]
[app.common.types.shape.images :as images]
[app.common.uri :as u]
[app.common.uuid :as uuid]
[cuerdas.core :as str]
[exporter.shell :as shell]
[exporter.util.mime :as mime]
[exporter.wasm :as wasm]
[exporter.wasm.serialize :as serialize]))
(def fetch
"The network entry point of the pipeline: a plain def, redefined by
the tests, which never need a network."
http/fetch)
;; --- module lifecycle (one shared, lazily-initialized instance)
(defonce ^:private module* (atom nil))
(defn- ^:async ensure-module
[]
(or @module*
(reset! module* (await (wasm/init)))))
;; --- backend endpoints
;;
;; Every fetch targets the internal endpoint (falling back to public-uri),
;; in a deployment the exporter reaches the backend over the container network
(defn internal-uri
"Absolute URI for `path` on the internal (backend) endpoint."
[env path]
(-> (:internal-uri env)
(u/ensure-path-slash)
(u/join path)
(str)))
(defn public-uri
"Absolute URI for `path` on the public endpoint. Whoever opens an exported SVG
resolves its `@font-face` sources, so those cannot use the internal endpoint."
[env path]
(-> (:public-uri env)
(u/ensure-path-slash)
(u/join path)
(str)))
(defn error-detail
"Node's fetch reports every transport failure as a bare `TypeError: fetch
failed`; the actual reason (TLS rejection, DNS, ECONNREFUSED) is buried in a
nested `cause` chain that the logger does not print. Flattens the chain into
one readable string."
[cause]
(->> (iterate (fn [^js e] (unchecked-get e "cause")) cause)
(take-while some?)
(take 5)
(map (fn [^js e]
(let [code (unchecked-get e "code")
msg (or (unchecked-get e "message") (str e))]
(if code (str code ": " msg) msg))))
(str/join " <- ")))
(defn- ^:async request
"`undici/fetch` that fails with an ex-info carrying the target uri and the
unwrapped cause chain, so a failed request says what actually went wrong and
against which endpoint."
[uri opts]
(try
(await (fetch uri opts))
(catch :default cause
(throw (ex-info "http fetch failed"
{:uri uri :detail (error-detail cause)}
cause)))))
(defn- explain
"Log-friendly reason for `cause`: the detail `request` already attached, or a
freshly unwrapped chain for anything else (WASM aborts, decode errors)."
[cause]
(or (:detail (ex-data cause))
(error-detail cause)))
(defn- rpc-headers
"Auth headers for backend RPC calls (management key + bearer)."
[env token]
#js {"Content-Type" "application/transit+json"
"X-Shared-Key" (str "exporter " (:management-key env))
"Authorization" (str "Bearer " token)})
(defn- asset-headers
"Auth headers for `/assets/*`. Cookie, not Bearer: those endpoints redirect to
a presigned S3/minio URL, and a Bearer header makes S3 400 (\"multiple
authentication types\")."
[env token]
#js {"X-Shared-Key" (str "exporter " (:management-key env))
"Cookie" (str "auth-token=" token)})
;; --- shape bundle fetch (backend RPC)
(defn ^:async fetch-objects
"Fetches the exported roots and their children from the backend via the
`get-page` RPC (`:object-id`, as the browser render path does), using the
same auth the exporter uses elsewhere (management key + bearer)."
[env {:keys [file-id page-id share-id token objects]}]
(let [headers (rpc-headers env token)
root-ids (into #{} (map :id) objects)
body (t/encode-str (cond-> {:file-id file-id
:page-id page-id}
(seq root-ids) (assoc :object-id root-ids)
share-id (assoc :share-id share-id)))
uri (internal-uri env "api/rpc/command/get-page")]
(l/dbg :hint "wasm render: get-page"
:uri uri
:file-id (str file-id)
:page-id (str page-id)
:roots (count root-ids))
(let [resp (await (request uri #js {:method "POST" :headers headers :body body}))]
(if (= 200 (.-status resp))
(:objects (t/decode-str (await (.text resp))))
(let [resp-body (await (.text resp))]
(l/error :hint "wasm render: get-page failed"
:uri uri
:status (.-status resp)
:body resp-body)
(throw (ex-info "get-page failed"
{:status (.-status resp)
:body resp-body})))))))
;; --- font resolution
;;
;; The text serializer keeps each font's real uuid, so `wasm/fonts-for-shape`
;; reports it. Custom (team) fonts resolve through the file's font variants,
;; google fonts through the shared `app.common.fonts` catalog; builtin
;; fonts through its bundled family + the frontend's static `/fonts/`.
(defn ^:async fetch-font-variants
"Team (custom) font variants for the file, or nil — a failure here degrades
to fallback fonts, it does not fail the export."
[env {:keys [file-id share-id token]}]
(let [headers (rpc-headers env token)
body (t/encode-str (cond-> {:file-id file-id}
share-id (assoc :share-id share-id)))
uri (internal-uri env "api/rpc/command/get-font-variants")]
(try
(let [resp (await (request uri #js {:method "POST" :headers headers :body body}))]
(when (= 200 (.-status resp))
(t/decode-str (await (.text resp)))))
(catch :default cause
(l/warn :hint "wasm render: get-font-variants failed"
:uri uri :detail (explain cause) :cause cause)
nil))))
(defn- ^:async fetch-ttf-bytes
"Downloads a TTF (an ArrayBuffer, or nil). A failure here degrades to
fallback fonts, it does not fail the export."
[uri opts]
(try
(let [resp (await (request uri opts))]
(when (= 200 (.-status resp))
(await (.arrayBuffer resp))))
(catch :default cause
(l/warn :hint "wasm render: font fetch failed"
:uri uri :detail (explain cause) :cause cause)
nil)))
;; TTF bytes cached for the process lifetime, keyed by whatever identifies the
;; variant (a gfont id+weight+style, a builtin file name).
(defonce ^:private font-bytes* (atom {}))
(defn- ^:async cached-ttf-bytes
[cache-key fetch-fn]
(if-let [bytes (get @font-bytes* cache-key)]
bytes
(let [buf (await (fetch-fn))]
(when buf (swap! font-bytes* assoc cache-key buf))
buf)))
(defn- ^:async fetch-asset-bytes
[env asset-id token]
(fetch-ttf-bytes (internal-uri env (str "assets/by-id/" asset-id))
#js {:method "GET" :headers (asset-headers env token)}))
(defn- ^:async fetch-gfont-bytes
[env ttf-url]
(fetch-ttf-bytes (cfnt/gstatic->proxy-url ttf-url (internal-uri env "internal/gfonts/font"))
#js {:method "GET"}))
(defn- ^:async fetch-builtin-font-bytes
[env ttf-file]
(cached-ttf-bytes ttf-file #(fetch-ttf-bytes (internal-uri env (str "fonts/" ttf-file))
#js {:method "GET"})))
(defn family-uuid
[id]
(uuid/from-unsigned-parts (aget id 0) (aget id 1) (aget id 2) (aget id 3)))
(defn find-variant
"Custom variant for a family: uuid+weight+style first, degrading to
uuid+weight then uuid."
[variants font-uuid weight style]
(let [style-str (if (zero? style) "normal" "italic")]
(or (d/seek (fn [v] (and (= (:font-id v) font-uuid)
(= (:font-weight v) weight)
(= (name (:font-style v)) style-str)))
variants)
(d/seek (fn [v] (and (= (:font-id v) font-uuid)
(= (:font-weight v) weight)))
variants)
(d/seek (fn [v] (= (:font-id v) font-uuid)) variants))))
(defn- make-resolve-font
"Builds a `resolve-font` fn (family map -> TTF bytes). Custom
variants first; the bundled fonts for `uuid/zero`, which is what
`font-id->uuid` maps every builtin family to; google catalog otherwise."
[env variants params]
(^:async fn [{:keys [id weight style]}]
(let [font-uuid (family-uuid id)
variant (find-variant variants font-uuid weight style)]
(cond
(:ttf-file-id variant)
(await (fetch-asset-bytes env (:ttf-file-id variant) params))
(= uuid/zero font-uuid)
(await (fetch-builtin-font-bytes env (cfnt/resolve-ttf-file weight style)))
:else
(if-let [gurl (cfnt/resolve-ttf-url font-uuid weight style)]
(await (fetch-gfont-bytes env gurl))
nil)))))
(defn- make-font-url
"Builds a `font-url` fn (family map -> public URL of its TTF), the same
sources `make-resolve-font` downloads from but addressed publicly. The SVG
export emits one `@font-face` per family from these."
[env variants]
(fn [{:keys [id weight style]}]
(let [font-uuid (family-uuid id)
variant (find-variant variants font-uuid weight style)]
(cond
(:ttf-file-id variant)
(public-uri env (str "assets/by-id/" (:ttf-file-id variant)))
(= uuid/zero font-uuid)
(public-uri env (str "fonts/" (cfnt/resolve-ttf-file weight style)))
:else
(some-> (cfnt/resolve-ttf-url font-uuid weight style)
(cfnt/gstatic->proxy-url (public-uri env "internal/gfonts/font")))))))
;; --- fallback fonts (emoji + per-script noto fonts)
;;
;; Emoji and non-latin scripts render through fallback families, not through
;; any span's font family, so `wasm/fonts-for-shape` never reports them and the
;; provisioning above never uploads them. Must run per request, since
;; `clear-fonts` empties the store; the TTF bytes stay cached per process.
(defn scene-fallback-fonts
"Fallback font descriptors needed by the scene's text. Deduped because
several languages map to one noto family and provisioning is concurrent —
otherwise they all miss the byte cache at once and refetch the same TTF."
[scene]
(let [texts (for [shape (vals scene)
:when (= :text (:type shape))
node (or (some->> (:content shape) (tree-seq :children :children)) [])
:let [text (:text node)]
:when (string? text)]
text)
emoji? (boolean (some cfnt/contains-emoji? texts))
langs (reduce cfnt/collect-used-languages #{} texts)]
(distinct
(cond-> (cfnt/add-noto-fonts [] langs)
emoji? (cfnt/add-emoji-font)))))
(defn- ^:async fetch-fallback-font-bytes
"Downloads one fallback font's TTF. Cached by the whole variant, not just
`font-id`: `resolve-ttf-url` picks a different TTF per weight/style, so a
font-id-only key would serve the first downloaded variant for every other one."
[env {:keys [font-id weight style]}]
(if-let [ttf-url (some-> (cfnt/gfont-id->uuid font-id) (cfnt/resolve-ttf-url weight style))]
(cached-ttf-bytes [font-id weight style] #(fetch-gfont-bytes env ttf-url))
nil))
(defn- ^:async provision-fallback-fonts
[env scene]
(await (js/Promise.all
(mapv (^:async fn [{:keys [font-id weight style is-emoji is-fallback] :as font}]
(if-let [font-uuid (cfnt/gfont-id->uuid font-id)]
(let [buf (await (fetch-fallback-font-bytes env font))]
(if buf
(wasm/store-font {:id (uuid/get-u32 font-uuid)
:weight weight
:style style
:emoji? (boolean is-emoji)
:fallback? (boolean is-fallback)}
buf)
(l/warn :hint "wasm render: fallback font unavailable"
:font-id font-id)))
nil))
(scene-fallback-fonts scene))))
nil)
;; --- image resolution
;;
;; Image fills reference file-media ids; the encoded bytes go straight to
;; `_store_image` (Skia decodes, no WebGL), keyed by media uuid so this happens
;; once per request rather than per rendered object.
(defn ^:async fetch-file-media-bytes
"Downloads an image fill's encoded bytes by file-media id, or nil when
they cannot be had: the object renders without its image either way."
[env media-id token]
(let [headers (asset-headers env token)
uri (internal-uri env (str "assets/by-file-media-id/" media-id))]
(try
(let [resp (await (request uri #js {:method "GET" :headers headers}))]
(if (= 200 (.-status resp))
(await (.arrayBuffer resp))
(do
(l/warn :hint "wasm render: image fetch non-200"
:media-id (str media-id)
:uri uri
:status (.-status resp))
nil)))
(catch :default cause
(l/warn :hint "wasm render: image fetch failed"
:media-id (str media-id) :uri uri
:detail (explain cause) :cause cause)
nil))))
(defn- ^:async provision-images
"Fetches and stores every image the scene references (shape, stroke and
text-span fills, enumerated by `app.common.types.shape.images`). Unlike fonts,
the image store is not reset per request, so already-held images are skipped
and repeated exports of a file reuse them.
Always registers a public media URL for each id so SVG export can emit linked
`<image href>` even when the encoded bytes were already cached."
[env scene params]
(let [all-ids (images/scene-image-ids scene)
new-ids (remove wasm/image-cached? all-ids)]
(l/dbg :hint "wasm render: provisioning images"
:total (count all-ids)
:cached (- (count all-ids) (count new-ids)))
(doseq [image-id all-ids]
(wasm/store-image-url image-id (public-uri env (str "assets/by-file-media-id/" image-id))))
(await (js/Promise.all
(mapv (^:async fn [image-id]
(let [buf (await (fetch-file-media-bytes env image-id (:token params)))]
(if buf
(do
(l/dbg :hint "wasm render: image stored"
:media-id (str image-id)
:bytes (.-byteLength ^js buf))
(wasm/store-image image-id buf))
(l/warn :hint "wasm render: image unavailable"
:media-id (str image-id))))
nil)
new-ids)))
nil))
(defn- relayout-text
"Recomputes layout for every text shape, once the real fonts are provisioned
(serialize-time layout used the fallback)."
[scene]
(doseq [shape (vals scene)
:when (= :text (:type shape))]
(wasm/update-text-layout (:id shape))))
;; --- render
(defn- check-cancelled
"Cancellation is cooperative: a render already inside Skia cannot be
interrupted, so the flag is only observed between objects. Killing a job
mid-object is the caller's job (terminating the worker)."
[{:keys [cancelled?] :as _params}]
(when (and cancelled? (cancelled?))
(ex/raise :type :internal
:code :job-cancelled
:hint "export job was cancelled")))
(defn- render-object-bytes
[type id scale]
(case type
:pdf (let [bytes (wasm/render-shape-pdf id scale)]
(l/dbg :hint "PDF generated via Skia (render-wasm headless)"
:object-id (str id)
:backend "skia-wasm"
:bytes (.-length bytes))
bytes)
:svg (let [bytes (wasm/render-shape-svg id scale)]
(l/dbg :hint "SVG generated via Skia (render-wasm headless)"
:object-id (str id)
:backend "skia-wasm"
:bytes (.-length bytes))
bytes)
(wasm/render-shape-raster id scale type)))
(defn- ^:async render*
[env {:keys [scale type objects] :as params} on-object]
(l/dbg :hint "wasm render: start"
:type type
:scale scale
:objects (count objects)
:file-id (str (:file-id params))
:page-id (str (:page-id params)))
(try
(await (ensure-module))
(let [scene (await (fetch-objects env params))]
(l/dbg :hint "wasm render: scene fetched" :shapes (count scene))
(serialize/serialize-scene scene)
(l/dbg :hint "wasm render: scene serialized")
;; So fonts from a previous request don't leak into this one.
(wasm/clear-fonts)
(let [[variants] (await (js/Promise.all [(fetch-font-variants env params)
(provision-images env scene params)
(provision-fallback-fonts env scene)]))
variants (or variants [])
resolve-font (make-resolve-font env variants params)
font-url (make-font-url env variants)]
;; Before rendering, so the relayout below sees real
;; font metrics. Deduped across objects: shapes
;; sharing one family download its TTF once.
(await (wasm/provision-fonts (map :id objects) resolve-font
:font-url font-url)))
(relayout-text scene)
;; Sequential, like the synchronous Skia calls underneath:
;; the cancel check lands between objects.
(doseq [{:keys [id] :as object} objects]
(check-cancelled params)
(let [bytes (render-object-bytes type id scale)
path (shell/tempfile (:tmpdir env)
:prefix "penpot.tmp.wasm."
:suffix (mime/get-extension type))]
(l/dbg :hint "wasm render: object rendered"
:object-id (str id) :bytes (.-length bytes))
(fs/writeFileSync path bytes)
(await (on-object (assoc object :path path)))))
;; After the request, never mid-render, so an image can't
;; disappear under a running export.
(let [evicted (wasm/evict-images (:image-cache-size env))]
(when (pos? evicted)
(l/info :hint "wasm render: evicted cached images" :count evicted)))
nil)
(catch :default cause
(l/error :hint "wasm render: failed"
:detail (explain cause)
:internal-uri (str (:internal-uri env))
:cause cause)
;; A panic can leave the mem buffer allocated or the instance
;; aborted; drop it so the next request rebuilds a fresh one.
(reset! module* nil)
(throw cause))))
(defn ^:async render
"Public entry. Renders every object of `params` with the render
environment `env` (`:internal-uri`, `:public-uri`, `:management-key`,
`:tmpdir`, `:image-cache-size`), calling `on-object` with
`{:id :filename :path ...}` as each one is written out."
[env params on-object]
(await (render* env params on-object)))

6
exporter/src/app/wasm/serialize.cljs → exporter/src/exporter/wasm/serialize.cljs
View File

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.wasm.serialize
(ns exporter.wasm.serialize
"Browser-free shape serialization for the headless exporter: the counterpart
of `app.render-wasm.api/set-object`, which cannot be reused directly because
its namespace pulls React/DOM/store. Only the call sequencing lives here —
@ -12,13 +12,13 @@
WASM are the editor's.
Covers everything except svg-raw. Image bytes and fonts are provisioned
separately by `app.renderer.wasm`."
separately by the render pipeline."
(:require
[app.common.render-wasm.api.props :as props]
[app.common.render-wasm.helpers :as h]
[app.common.render-wasm.serialize-shape :as serialize-shape]
[app.common.render-wasm.wasm :as wasm]
[app.wasm.text :as text]))
[exporter.wasm.text :as text]))
(defn set-shape
"Serializes a single shape into the WASM design state. The host-independent

2
exporter/src/app/wasm/text.cljs → exporter/src/exporter/wasm/text.cljs
View File

@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns app.wasm.text
(ns exporter.wasm.text
"Browser-free text-content serialization for the headless exporter. Only the
paragraph walk is local: the binary layout and the font-id -> uuid mapping
both come from `app.common.render-wasm.text-content`."

85
exporter/src/exporter/wasm/worker.cljs Normal file
View File

@ -0,0 +1,85 @@
;; 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 exporter.wasm.worker
"Render worker entry point.
Owns one render-wasm module and renders one export request at a time. The
Skia calls are synchronous, so running them here is what lets several exports
progress at once: the main thread keeps polling the queue and settling jobs
while this thread is blocked inside a render. There are no promesa chains
in this namespace.
Messages in: {type: \"render\", params: <transit>, cancel: SharedArrayBuffer}
Messages out: {type: \"ready\"}
{type: \"object\", payload: <transit>} one per rendered object
{type: \"done\"} | {type: \"error\", message, code}"
(:require
["node:worker_threads" :as wt]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.transit :as t]
[exporter.wasm.render :as render]))
(def parent-port
"The channel renders report through: the parent port of a render
thread. A plain def so tests — which run on the main thread, where
the port is null — rebind it, the way they rebind `fetch`."
wt/parentPort)
(defn- post
[message]
(.postMessage ^js parent-port message))
(defn- cancelled-fn
[buffer]
(if (some? buffer)
(let [signal (js/Int32Array. buffer)]
(fn [] (pos? (js/Atomics.load signal 0))))
(constantly false)))
(defn ^:async handle-render
"One render message: split the render env off the params, run the
pipeline, and post every object plus the settle. Never rejects: a
failure posts `error`, so the main thread always settles the lease."
[data]
(try
(let [{env ::render/env :as params} (t/decode-str (unchecked-get data "params"))]
(when (nil? env)
(throw (ex/error :type :assertion
:code :env-missing
:hint "worker render needs ::render/env in params")))
(let [params (assoc (dissoc params ::render/env)
:cancelled? (cancelled-fn (unchecked-get data "cancel")))]
(await (render/render env params
(fn [object]
(post #js {:type "object" :payload (t/encode-str object)}))))
(post #js {:type "done"})))
(catch :default cause
(l/warn :hint "render worker: request failed" :cause cause)
(post #js {:type "error"
:message (or (ex-message cause) (str cause))
:code (some-> cause ex-data :code name)}))))
(defn- on-message
[data]
(case (unchecked-get data "type")
"render" (handle-render data)
(l/warn :hint "render worker: unknown message" :type (unchecked-get data "type"))))
(defonce ^:private listening
;; `defonce` survives a hot reload, so a reload does not stack a second
;; listener on the port. The indirection through the var keeps the reloaded
;; `on-message` in play instead of pinning the one captured at boot.
(delay
(.on ^js wt/parentPort "message" (fn [data] (on-message data)))
true))
(defn main
[& _]
@listening
(post #js {:type "ready"})
(l/info :hint "render worker ready"))

192
exporter/test/exporter_tests/api_test.cljs
View File

@ -1,192 +0,0 @@
;; 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 exporter-tests.api-test
"The management client of the worker against a fake http: what it
sends (method uri, shared key, shape of the body) is the whole
contract this client owns."
(:require
["node:fs/promises" :as fsp]
["node:path" :as path]
["undici" :as http]
[app.common.transit :as transit]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.consumer.api :as api]
[app.util.shell :as sh]
[cljs.core :as c]
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]
[promesa.core :as p]))
(def ^:private original-fetch api/fetch)
(def ^:private calls
"Every fetch the client made, in order."
(atom []))
(defn- fake-fetch
[uri request]
(swap! calls conj [uri request])
(p/resolved #js {:status 200
:text (constantly (p/resolved (transit/encode-str {:action :run})))}))
(defn- failure-fetch
"A fake that answers like a management endpoint that refuses the key."
[_uri _request]
(p/resolved #js {:status 403
:text (constantly (p/resolved "{}"))}))
(defn- install-fetch
"Put a fake in place and return the thunk that puts the original
back. The thunk belongs at the end of the promise chain's `p/do`, so
the fake covers the whole async run."
([] (install-fetch fake-fetch))
([the-fake]
(set! api/fetch the-fake)
(reset! calls [])
(fn [] (set! api/fetch original-fetch))))
(defn- last-request
[]
(second (last @calls)))
(defn- fetch-header
"One header of the last request, exactly as it would travel."
[name]
(unchecked-get (.-headers (second (last @calls))) name))
(defn- body-value
"One field of the last FormData request."
[name]
(.get (.-body (last-request)) name))
(defn- decode-body
"The body of the last transit request, decoded."
[]
(transit/decode-str (.-body (last-request))))
(defn- last-uri
[]
(first (last @calls)))
(defn- with-restore-and-done
"Run `thunk`, then put the original fetch back, then say the test is
finished: the rest never waits on the assertions, so a broken chain
reports a failure, never a hang."
[thunk restore-fetch done]
(p/do thunk (restore-fetch) (done)))
(t/deftest claim-job-posts-the-claim-of-one-poller
(t/async done
(let [job-id (uuid/next)
restore-fetch (install-fetch)]
(with-restore-and-done
(p/fmap (fn [_]
(t/is (str/ends-with? (last-uri) "/api/management/methods/claim-job"))
(t/is (= (str "exporter " cf/management-key) (fetch-header "X-Shared-Key")))
(t/is (= {:job-id job-id :scheduled-at "2026-10-07T00:00:00Z"}
(decode-body))))
(api/claim-job job-id "2026-10-07T00:00:00Z"))
restore-fetch
done))))
(t/deftest json-calls-declare-the-transit-content-type
;; without it the backend never parses the body as transit and
;; validates an empty map (every key a `missing-key`)
(t/async done
(let [restore-fetch (install-fetch)]
(with-restore-and-done
(p/fmap (fn [_]
(t/is (= "application/transit+json"
(fetch-header "Content-Type"))))
(api/claim-job (uuid/next) "2026-10-07T00:00:00Z"))
restore-fetch
done))))
(t/deftest report-job-progress-posts-the-beat
(t/async done
(let [job-id (uuid/next)
progress {:stage :rendering
:counters {:objects {:current 1 :total 2}}}
restore-fetch (install-fetch)]
(with-restore-and-done
(p/fmap (fn [_]
(t/is (str/ends-with? (last-uri) "/api/management/methods/report-job-progress"))
(t/is (= {:job-id job-id :progress progress} (decode-body))))
(api/report-job-progress job-id progress))
restore-fetch
done))))
(t/deftest fail-job-carries-the-error-and-the-session
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
error {:type :internal :code :processing-error :hint "boom"}
restore-fetch (install-fetch)]
(with-restore-and-done
(p/mcat (fn [_]
(p/fmap (fn [_]
(t/is (= {:job-id job-id :error error :session-id sid}
(decode-body))))
(api/fail-job job-id error :session-id sid)))
(api/fail-job job-id error))
restore-fetch
done))))
(t/deftest complete-job-posts-the-plain-result
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
restore-fetch (install-fetch)]
(with-restore-and-done
(p/mcat (fn [_]
(p/fmap (fn [_]
(t/is (= {:job-id job-id :result {:total 1} :session-id sid}
(decode-body))))
(api/complete-job job-id {:total 1} {:session-id sid})))
(api/complete-job job-id {:total 1}))
restore-fetch
done))))
(t/deftest complete-job-with-artifact-rides-multipart
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
tmpfile (path/join sh/tmpdir (str "test-artifact." (uuid/next)))
restore-fetch (install-fetch)]
(with-restore-and-done
(p/mcat (fn [_]
(p/fmap (fn [_]
(t/is (instance? http/FormData (.-body (last-request))))
(t/is (= (str job-id) (body-value "job-id")))
(t/is (= "export.zip" (body-value "filename")))
(t/is (= "application/zip" (body-value "mtype")))
(t/is (= (str sid) (body-value "session-id")))
(t/is (= (str "exporter " cf/management-key)
(fetch-header "X-Shared-Key"))))
(api/complete-job-with-artifact
{:job-id job-id :session-id sid}
{:path tmpfile
:filename "export.zip"
:mtype "application/zip"})))
(->> (fsp/writeFile tmpfile "the export bytes")
(p/fmap (fn [_] nil))))
restore-fetch
done))))
(t/deftest a-failed-management-answer-is-the-failure-of-the-call
(t/async done
(let [restore-fetch (install-fetch failure-fetch)]
(with-restore-and-done
(p/catch (fn [error]
(let [data (ex-data error)]
(t/is (= :internal (:type data)))
(t/is (= :failed-management-request (:code data)))
(t/is (= 403 (:status data)))))
(api/claim-job (uuid/next) "2026-10-07T00:00:00Z"))
restore-fetch
done))))

4
exporter/test/exporter_tests/browser_scope_test.cljs
View File

@ -11,9 +11,9 @@
["generic-pool" :as gp]
["node:os" :as os]
[app.common.uuid :as uuid]
[app.config :as cf]
[cljs.test :as t :include-macros true]
[exporter.browser.scope :as scope]))
[exporter.browser.scope :as scope]
[exporter.config :as cf]))
(defn- stub-locator
[]

6
exporter/test/exporter_tests/consumer_api_test.cljs
View File

@ -10,14 +10,14 @@
contract this client owns."
(:require
["node:fs/promises" :as fsp]
["node:os" :as os]
["node:path" :as path]
["undici" :as http]
[app.common.transit :as transit]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.util.shell :as sh]
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]
[exporter.config :as cf]
[exporter.consumer.api :as api]))
(def ^:private original-fetch api/fetch)
@ -145,7 +145,7 @@
(try
(let [job-id (uuid/next)
sid (uuid/next)
tmpfile (path/join sh/tmpdir (str "test-artifact." (uuid/next)))]
tmpfile (path/join (os/tmpdir) (str "test-artifact." (uuid/next)))]
(await (fsp/writeFile tmpfile "the export bytes"))
(await (api/complete-job-with-artifact
{:job-id job-id :session-id sid}

26
exporter/test/exporter_tests/consumer_config_test.cljs
View File

@ -1,26 +0,0 @@
;; 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 exporter-tests.consumer-config-test
"The consumer side of the config: how many jobs run at once and
which queue they come from."
(:require
[app.consumer.config :as ccfg]
[cljs.test :as t :include-macros true]))
(t/deftest concurrency-is-at-least-one
(t/testing "the configured value is taken as given"
(t/is (= 2 (ccfg/concurrency 2)))
(t/is (= 4 (ccfg/concurrency 4))))
(t/testing "zero or less is a misconfiguration, floored to one"
(t/is (= 1 (ccfg/concurrency 0)))
(t/is (= 1 (ccfg/concurrency -3))))
(t/testing "an unset value falls back to the default K"
(t/is (= 2 (ccfg/concurrency nil)))))
(t/deftest queue-key-names-tenant-and-queue
(t/is (= "penpot.worker.queue:main:exporter"
(ccfg/queue-key "main"))))

31
exporter/test/exporter_tests/consumer_plan_test.cljs
View File

@ -1,31 +0,0 @@
;; 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 exporter-tests.consumer-plan-test
"Chunking of the browser backend."
(:require
[app.common.uuid :as uuid]
[app.consumer.plan :as plan]
[cljs.test :as t :include-macros true]))
(defn- exports
[n type scale]
(let [file-id (uuid/next)
page-id (uuid/next)]
(mapv (fn [i]
{:file-id file-id
:page-id page-id
:object-id (uuid/next)
:name (str "shape-" i)
:suffix ""
:scale scale
:type type})
(range n))))
(t/deftest browser-exports-are-chunked
(let [parts (plan/prepare-exports (exports 120 :png 1) "token" false)]
(t/is (= 3 (count parts)))
(t/is (= [50 50 20] (mapv (comp count :objects) parts)))))

50
exporter/test/exporter_tests/exporter_config_test.cljs Normal file
View File

@ -0,0 +1,50 @@
;; 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 exporter-tests.exporter-config-test
"The process configuration, read from the environment: kebab-case
keys under the `PENPOT_` prefix, decoded and validated against the
schema, with the management key derived the way the backend expects."
(:require
[cljs.test :as t :include-macros true]
[exporter.config :as cf]))
(t/deftest read-env-keeps-only-the-prefixed-keys
(let [env (cf/read-env #js {"PENPOT_SECRET_KEY" "s"
"PENPOT_EXPORTER_WORKER_CONCURRENCY" "4"
"OTHER_THING" "y"})]
(t/is (= {:secret-key "s"
:exporter-worker-concurrency "4"}
env))))
(t/deftest prepare-config-applies-defaults-and-coerces
(let [config (cf/prepare-config #js {"PENPOT_SECRET_KEY" "s"
"PENPOT_EXPORTER_WORKER_CONCURRENCY" "4"})]
(t/is (= "s" (:secret-key config)))
(t/is (= "default" (:tenant config)))
(t/is (= "/tmp/penpot" (:tempdir config)))
(t/is (= 4 (:exporter-worker-concurrency config)))))
(t/deftest prepare-config-refuses-a-missing-secret
;; the secret is the one key without a default: without it the
;; process cannot derive its management key, so the config is
;; invalid. It throws (testable) instead of exiting: only the
;; wiring entry exits, on the live environment.
(let [cause (try
(cf/prepare-config #js {})
nil
(catch :default cause
cause))]
(t/is (some? cause))
(t/is (= :invalid-config (:code (ex-data cause))))))
(t/deftest derive-management-key-matches-the-legacy-formula
;; the backend derives the same key from the same secret (HKDF
;; blake2b512 over "exporter", 32 bytes, base64url): the hardcoded
;; value pins the formula, so a refactor cannot silently mint a key
;; the backend rejects.
(t/is (= "ASwdQtEgXamXWme1LXZTcH5lvKR5WEbIHrf1i5mDWa4"
(cf/derive-management-key "test-secret-key"))))

55
exporter/test/exporter_tests/exporter_resources_test.cljs Normal file
View File

@ -0,0 +1,55 @@
;; 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 exporter-tests.exporter-resources-test
"The run's local resources: the artifact files parked in the injected
temp area until the settle uploads them, zipped once a run packs more
than one."
(:require
["node:fs/promises" :as fsp]
["node:os" :as os]
["node:path" :as path]
[app.common.uuid :as uuid]
[cljs.test :as t :include-macros true]
[clojure.string :as cstr]
[exporter.resources :as rsc]))
(defn- test-area
[]
(let [dir (path/join (os/tmpdir) (str "penpot-resources-test." (uuid/next)))]
dir))
(t/deftest create-parks-the-artifact-under-the-injected-tmpdir
(let [dir (test-area)
resource (rsc/create dir :pdf "a/b:c")]
(t/testing "the path lives in the injected area, named by type"
(t/is (cstr/starts-with? (:path resource) dir))
(t/is (cstr/includes? (:path resource) "penpot.resource.pdf.")))
(t/testing "the descriptor names the upload"
(t/is (= "application/pdf" (:mtype resource)))
(t/is (= "a_b_c.pdf" (:filename resource)))
(t/is (= "a/b:c" (:name resource))))
(t/is (uuid? (:id resource)))))
(t/deftest ^:async zip-packs-added-files
(let [dir (test-area)
_ (await (fsp/mkdir dir #js {:recursive true}))
resource (rsc/create dir :zip "the export")
member (path/join dir "member.txt")]
(try
(await (fsp/writeFile member "member!"))
(let [entries (atom [])
zip (rsc/create-zip :resource resource
:on-progress (fn [e] (swap! entries conj e)))]
(rsc/add-to-zip zip member "member.txt")
(await (rsc/close-zip zip))
(t/testing "the artifact landed"
(let [stat (await (fsp/stat (:path resource)))]
(t/is (pos? (.-size stat)))))
(t/testing "one entry traveled with its name"
(t/is (= [{:done 1 :filename "member.txt"}] @entries))))
(finally
(await (fsp/rm dir #js {:recursive true :force true}))))))

13
exporter/test/exporter_tests/exporter_shell_test.cljs
View File

@ -66,3 +66,16 @@
(t/is (str/includes? (str out) "hello")))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))
(t/deftest ^:async run-cmd-passes-arguments-literally
;; GHSA-4f36-m4hj-cv86 stays fixed: the wrapper runs execFile, so
;; shell metacharacters in args travel literally and never execute.
(try
(let [marker (path/join (os/tmpdir) "penpot-rce-probe")
out (await (shell/run-cmd "echo" (str "#000000$(touch " marker ")")))]
(t/is (str/includes? (str out) "$(touch ")
"the metacharacters traveled, they did not run")
(t/is (not (fs/existsSync marker))
"no RCE: the marker file was NOT created"))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))

78
exporter/test/exporter_tests/exporter_tmpdir_test.cljs Normal file
View File

@ -0,0 +1,78 @@
;; 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 exporter-tests.exporter-tmpdir-test
"The temp area owns what jobs park in it: every path a job tracks is
removed on its release, and the boot clean drops whatever a previous
process left behind."
(:require
["node:fs" :as fs]
["node:fs/promises" :as fsp]
["node:os" :as os]
["node:path" :as path]
[app.common.uuid :as uuid]
[cljs.test :as t :include-macros true]
[exporter.tmpdir :as tmpdir]
[exporter.utils.system :as system]))
(defn- test-area
[]
(path/join (os/tmpdir) (str "penpot-tmpdir-test." (uuid/next))))
(defn- ^:async write
[dir name content]
(let [p (path/join dir name)]
(await (fsp/writeFile p content))
p))
(t/deftest ^:async track-registers-and-release-removes
(let [dir (test-area)
_ (fs/mkdirSync dir #js {:recursive true})
job-id (uuid/next)
owned (tmpdir/track job-id (await (write dir "penpot.a.txt" "a")))
_ (tmpdir/track job-id (await (write dir "penpot.b.txt" "b")))]
(try
(t/is (= owned (path/join dir "penpot.a.txt")))
(await (tmpdir/release job-id))
(t/is (nil? (try (await (fsp/stat owned)) (catch :default _ nil)))
"tracked paths are gone after the release")
(t/testing "releasing twice, or an unknown job, is a no-op"
(await (tmpdir/release job-id))
(await (tmpdir/release (uuid/next))))
(finally
(await (fsp/rm dir #js {:recursive true :force true}))))))
(t/deftest ^:async clean-orphans-removes-only-aged-managed-files
(let [dir (test-area)
_ (fs/mkdirSync dir #js {:recursive true})
old (await (write dir "penpot.old.txt" "old"))
fresh (await (write dir "penpot.fresh.txt" "fresh"))
alien (await (write dir "other.txt" "other"))]
(try
(.utimesSync fs old (js/Date.) (js/Date. (- (js/Date.now) 7200000)))
(t/is (= 1 (await (tmpdir/clean-orphans dir 3600))))
(t/testing "the aged managed file is gone"
(t/is (nil? (try (await (fsp/stat old)) (catch :default _ nil)))))
(t/testing "fresh managed and unmanaged files stay"
(t/is (some? (await (fsp/stat fresh))))
(t/is (some? (await (fsp/stat alien)))))
(finally
(await (fsp/rm dir #js {:recursive true :force true}))))))
(t/deftest ^:async init-ensures-the-dir-and-cleans-orphans
(let [dir (test-area)]
(try
(t/is (= dir (await (system/init-key :exporter/tmpdir {:path dir :job-ttl 3600}))))
(t/is (some? (await (fsp/stat dir))))
(t/testing "a missing ttl fails fast instead of cleaning with a default"
(let [cause (try
(await (system/init-key :exporter/tmpdir {:path dir}))
nil
(catch :default cause
cause))]
(t/is (= :job-ttl-missing (:code (ex-data cause))))))
(finally
(await (fsp/rm dir #js {:recursive true :force true}))))))

28
exporter/test/exporter_tests/exporter_util_mime_test.cljs Normal file
View File

@ -0,0 +1,28 @@
;; 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 exporter-tests.exporter-util-mime-test
"The mimetype and file extension of every artifact type the worker
settles: the suffix of the temp file and the mtype of the upload."
(:require
[cljs.test :as t :include-macros true]
[exporter.util.mime :as mime]))
(t/deftest get-extension-names-every-artifact-type
(t/is (= ".png" (mime/get-extension :png)))
(t/is (= ".jpg" (mime/get-extension :jpeg)))
(t/is (= ".webp" (mime/get-extension :webp)))
(t/is (= ".svg" (mime/get-extension :svg)))
(t/is (= ".pdf" (mime/get-extension :pdf)))
(t/is (= ".zip" (mime/get-extension :zip))))
(t/deftest get-names-every-artifact-mimetype
(t/is (= "image/png" (mime/get :png)))
(t/is (= "image/jpeg" (mime/get :jpeg)))
(t/is (= "image/webp" (mime/get :webp)))
(t/is (= "image/svg+xml" (mime/get :svg)))
(t/is (= "application/pdf" (mime/get :pdf)))
(t/is (= "application/zip" (mime/get :zip))))

62
exporter/test/exporter_tests/exporter_util_object_test.cljs Normal file
View File

@ -0,0 +1,62 @@
;; 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 exporter-tests.exporter-util-object-test
"The javascript-object helpers the browser calls are built with:
reads that survive nil, writes that return the object, and the
clj→props translation of React prop names."
(:require
[cljs.test :as t :include-macros true]
[exporter.util.object :as obj]))
(t/deftest get-reads-and-survives-nil
(let [o #js {:a 1}]
(t/is (= 1 (obj/get o "a")))
(t/is (nil? (obj/get o "missing")))
(t/is (nil? (obj/get nil "a")))
(t/is (= :dflt (obj/get o "missing" :dflt)))
;; the default fires on undefined only: a nil object reads nil.
;; Same as the legacy (probe-verified), pinned so it stays that way.
(t/is (nil? (obj/get nil "a" :dflt)))))
(t/deftest get-in-threads-nil-safely
(let [o #js {:a #js {:b 2}}]
(t/is (= 2 (obj/get-in o ["a" "b"])))
(t/is (nil? (obj/get-in o ["a" "missing"])))
(t/is (nil? (obj/get-in nil ["a"])))
(t/is (= :dflt (obj/get-in o ["a" "missing"] :dflt)))))
(t/deftest set-and-update-return-the-object
(let [o (obj/new)]
(t/is (identical? o (obj/set! o "a" 1)))
(t/is (= 1 (obj/get o "a")))
(t/is (identical? o (obj/update o "a" inc)))
(t/is (= 2 (obj/get o "a")))
;; `update` on a missing key applies `f` to the sentinel instead of
;; skipping it — the legacy does exactly the same (probe-verified
;; `:app.util.object/not-found1`), so this pins parity, not intent:
;; never "fix" one side without the other.
(t/is (identical? o (obj/update o "missing" (constantly :set))))
(t/is (= :set (obj/get o "missing")))))
(t/deftest merge-copies-without-touching-the-inputs
(let [a #js {:x 1}
b #js {:y 2}
m (obj/merge a b)]
(t/is (= 1 (obj/get m "x")))
(t/is (= 2 (obj/get m "y")))
(t/is (nil? (obj/get a "y")))))
(t/deftest clj->props-camelizes-and-renames-class
(let [props (obj/clj->props {:background-color "red" :class "a"})]
(t/is (= "red" (obj/get props "backgroundColor")))
(t/is (= "a" (obj/get props "className")))))
(t/deftest in-checks-ownership
(let [o #js {:a 1}]
(t/is (true? (obj/in? o "a")))
(t/is (false? (obj/in? o "missing")))
(t/is (true? (obj/contains? o "a")))))

142
exporter/test/exporter_tests/exporter_wasm_render_test.cljs Normal file
View File

@ -0,0 +1,142 @@
;; 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 exporter-tests.exporter-wasm-render-test
"The headless render pipeline, without a render-wasm module: endpoint
building, error explaining, font-variant routing and the backend
fetches over a stubbed transport. The Skia calls themselves are
covered by the svg integration test."
(:require
[app.common.transit :as transit]
[app.common.uuid :as uuid]
[cljs.test :as t :include-macros true]
[exporter.wasm.render :as render]))
(def ^:private env
{:internal-uri "http://internal/"
:public-uri "http://public/"
:management-key "mgmt-key"
:tmpdir "/tmp/penpot-wasm-render-test"
:image-cache-size 100})
(t/deftest endpoint-builders-join-against-the-env-uris
(t/is (= "http://internal/api/rpc/command/get-page"
(render/internal-uri env "api/rpc/command/get-page")))
(t/is (= "http://public/assets/by-id/123"
(render/public-uri env "assets/by-id/123"))))
(t/deftest error-detail-flattens-the-fetch-cause-chain
(let [root (doto (js/Error. "connect ECONNREFUSED")
(unchecked-set "code" "ECONNREFUSED"))
cause (doto (js/Error. "fetch failed")
(unchecked-set "cause" root))]
(t/is (= "fetch failed <- ECONNREFUSED: connect ECONNREFUSED"
(render/error-detail cause)))
(t/is (= "boom" (render/error-detail (js/Error. "boom"))))))
(t/deftest find-variant-degrades-uuid-weight-then-uuid
(let [variants [{:font-id "f1" :font-weight 400 :font-style :normal}
{:font-id "f1" :font-weight 700 :font-style :italic}]]
(t/is (= {:font-id "f1" :font-weight 400 :font-style :normal}
(render/find-variant variants "f1" 400 0)))
(t/is (= {:font-id "f1" :font-weight 700 :font-style :italic}
(render/find-variant variants "f1" 700 1)))
(t/is (= {:font-id "f1" :font-weight 400 :font-style :normal}
(render/find-variant variants "f1" 400 1))
"style degrades before weight")
(t/is (nil? (render/find-variant variants "f9" 400 0)))))
(t/deftest family-uuid-delegates-to-the-shared-quartets
;; `family-uuid` is a one-line adapter over `app.common.uuid`: the
;; roundtrip itself belongs to `common`, not to this pipeline, so
;; this only pins that the adapter passes the quartet through in
;; order (a probing session showed `from-unsigned-parts` answering
;; zeroes in this bundle — suspected pre-existing `common` issue,
;; flagged separately, never worked around here).
(let [seen (atom nil)]
(with-redefs [uuid/from-unsigned-parts (fn [a b c d]
(reset! seen [a b c d])
:uuid)]
(t/is (= :uuid (render/family-uuid #js [11 22 33 44])))
(t/is (= [11 22 33 44] @seen)))))
(t/deftest scene-fallback-fonts-covers-emoji
(let [text-shape (fn [text]
{:type :text
:content {:children [{:children [{:children [{:text text}]}]}]}})
latin {(uuid/next) (text-shape "hello")}
emoji {(uuid/next) (text-shape "hi 😀")}]
(t/is (= [] (render/scene-fallback-fonts latin)))
(t/is (true? (boolean (some :is-emoji (render/scene-fallback-fonts emoji)))))))
(defn- stub-fetch
[calls respond]
(set! render/fetch
(fn [uri opts]
(swap! calls conj {:uri (str uri) :opts opts})
(js/Promise.resolve (respond (str uri))))))
(t/deftest ^:async fetch-objects-decodes-the-get-page-answer
(let [calls (atom [])
original render/fetch
file-id (uuid/next)
page-id (uuid/next)
shape {:id "s1" :type :rect}]
(stub-fetch calls
(fn [_uri]
#js {:status 200
:text (constantly
(js/Promise.resolve
(transit/encode-str {:objects {"s1" shape}})))}))
(try
(let [objects (await (render/fetch-objects
env {:file-id file-id
:page-id page-id
:token "tok"
:objects [{:id "s1"}]}))]
(t/testing "the scene travels back"
(t/is (= {"s1" shape} objects)))
(t/testing "the call rode the internal rpc with auth"
(let [{:keys [uri opts]} (first @calls)]
(t/is (= "http://internal/api/rpc/command/get-page" uri))
(t/is (= "Bearer tok" (unchecked-get (.-headers opts) "Authorization")))
(t/is (= "exporter mgmt-key" (unchecked-get (.-headers opts) "X-Shared-Key"))))))
(finally
(set! render/fetch original)))))
(t/deftest ^:async fetch-font-variants-degrades-to-nil
(let [original render/fetch]
(try
(stub-fetch (atom [])
(fn [_uri] #js {:status 500
:text (constantly (js/Promise.resolve ""))}))
(t/is (nil? (await (render/fetch-font-variants env {:file-id (uuid/next)
:token "tok"})))
"a non-200 is fallback fonts, not a failed export")
(set! render/fetch (fn [_uri _opts] (js/Promise.reject (js/Error. "down"))))
(t/is (nil? (await (render/fetch-font-variants env {:file-id (uuid/next)
:token "tok"})))
"a transport failure is fallback fonts too")
(finally
(set! render/fetch original)))))
(t/deftest ^:async fetch-file-media-bytes-passes-bytes-through
(let [original render/fetch]
(try
(stub-fetch (atom [])
(fn [_uri] #js {:status 200
:arrayBuffer (constantly
(js/Promise.resolve
(.from js/Buffer "img")))}))
(let [buf (await (render/fetch-file-media-bytes env (uuid/next) "tok"))]
(t/is (= 3 (.-byteLength buf))))
(stub-fetch (atom [])
(fn [_uri] #js {:status 404
:arrayBuffer (constantly
(js/Promise.resolve nil))}))
(t/is (nil? (await (render/fetch-file-media-bytes env (uuid/next) "tok"))))
(finally
(set! render/fetch original)))))

43
exporter/test/exporter_tests/renderer_svg_test.cljs → exporter/test/exporter_tests/exporter_wasm_svg_test.cljs
View File

@ -4,30 +4,30 @@
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns exporter-tests.renderer-svg-test
(ns exporter-tests.exporter-wasm-svg-test
"The SVG output of the headless pipeline over the real render-wasm
module: gradient defs and svg-attr fills survive the serialization."
(:require
[app.renderer.svg-gradient :as svg-gradient]
[app.wasm :as wasm-io]
[app.wasm.serialize :as serialize]
[cljs.test :refer [deftest is testing async]]
[cljs.test :as t :include-macros true]
[clojure.string :as str]
[promesa.core :as p]))
[exporter.renderer.svg-gradient :as svg-gradient]
[exporter.wasm :as wasm-io]
[exporter.wasm.serialize :as serialize]))
(def gradient-stops
[{"color" "#000000" "offset" 0 "opacity" 1}
{"color" "#ffffff" "offset" 1 "opacity" 1}])
(deftest creates-the-correct-gradient-element
(t/deftest creates-the-correct-gradient-element
(doseq [[gradient-type element-name]
[["linear" "linearGradient"]
["radial" "radialGradient"]]]
(testing gradient-type
(t/testing gradient-type
(let [gradient-data {"type" "gradient"
"gradient" {"type" gradient-type
"stops" gradient-stops}}
result (svg-gradient/data->gradient-def "text-id" ["#000001" gradient-data])]
(is (= element-name (get result "name")))))))
(t/is (= element-name (get result "name")))))))
(def ^:private svg-red-id (random-uuid))
(def ^:private blue-id (random-uuid))
@ -56,17 +56,12 @@
[shape-id]
(.toString (js/Buffer.from (wasm-io/render-shape-svg shape-id 1))))
(deftest exporter-honours-svg-attr-fills
(async done
(->> (wasm-io/init)
(p/mcat
(fn [_]
(serialize/serialize-scene (scene))
(let [red (render-svg-string svg-red-id)
blue (render-svg-string blue-id)]
(is (str/includes? blue "blue")
"control: user fills render, so the harness works")
(is (str/includes? red "fill=\"red\"")
"svg-attr fill survives headless serialization")
(p/resolved nil))))
(p/mcat (fn [_] (done))))))
(t/deftest ^:async exporter-honours-svg-attr-fills
(await (wasm-io/init))
(serialize/serialize-scene (scene))
(let [red (render-svg-string svg-red-id)
blue (render-svg-string blue-id)]
(t/is (str/includes? blue "blue")
"control: user fills render, so the harness works")
(t/is (str/includes? red "fill=\"red\"")
"svg-attr fill survives headless serialization")))

126
exporter/test/exporter_tests/exporter_wasm_worker_test.cljs 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 exporter-tests.exporter-wasm-worker-test
"The render worker entry over the real render-wasm module: one render
message runs the pipeline and posts every object plus the settle, a
failed pipeline posts the error. The backend travels stubbed."
(:require
["node:fs/promises" :as fsp]
["node:os" :as os]
["node:path" :as path]
[app.common.transit :as transit]
[app.common.uuid :as uuid]
[cljs.test :as t :include-macros true]
[clojure.string :as str]
[exporter.wasm.render :as render]
[exporter.wasm.worker :as worker]))
(def ^:private shape-id (random-uuid))
(defn- scene-shape
[]
{:id shape-id
:type :rect
:name "svg-red"
:x 10 :y 10 :width 100 :height 100
:rotation 0
:selrect {:x 10 :y 10 :x1 10 :y1 10 :x2 110 :y2 110
:width 100 :height 100}
:strokes []
:svg-attrs {:fill "#ff0000"}})
(defn- test-env
[tmpdir]
{:internal-uri "http://internal/"
:public-uri "http://public/"
:management-key "mgmt-key"
:tmpdir tmpdir
:image-cache-size 100})
(defn- test-params
[tmpdir]
{:file-id (uuid/next)
:page-id (uuid/next)
:token "tok"
:type :png
:scale 1
:objects [{:id shape-id :name "r" :suffix "" :filename "r.png"}]
::render/env (test-env tmpdir)})
(defn- install-port
[posts]
(let [original worker/parent-port]
(set! worker/parent-port
#js {:postMessage (fn [msg] (swap! posts conj (js->clj msg)))})
(fn [] (set! worker/parent-port original))))
(defn- install-fetch
[respond]
(let [original render/fetch]
(set! render/fetch
(fn [uri opts]
(js/Promise.resolve (respond (str uri) opts))))
(fn [] (set! render/fetch original))))
(defn- scene-fetch
[shape]
(install-fetch
(fn [uri _opts]
(cond
(str/ends-with? uri "get-page")
#js {:status 200
:text (constantly
(js/Promise.resolve
(transit/encode-str {:objects {(str (:id shape)) shape}})))}
:else
#js {:status 404
:text (constantly (js/Promise.resolve ""))
:arrayBuffer (constantly (js/Promise.resolve nil))}))))
(t/deftest ^:async handle-render-posts-objects-and-done
(let [tmpdir (path/join (os/tmpdir) (str "penpot-wasm-worker-test." (uuid/next)))]
(await (fsp/mkdir tmpdir #js {:recursive true}))
(let [posts (atom [])
restore-port (install-port posts)
restore-fetch (scene-fetch (scene-shape))]
(try
(await (worker/handle-render #js {:type "render"
:params (transit/encode-str (test-params tmpdir))
:cancel nil}))
(let [by-type (group-by #(get % "type") @posts)]
(t/testing "one object posted with its file"
(t/is (= 1 (count (get by-type "object"))))
(let [object (transit/decode-str (get (first (get by-type "object")) "payload"))]
(t/is (= shape-id (:id object)))
(t/is (str/starts-with? (:path object) tmpdir))))
(t/testing "the settle closed the lease"
(t/is (= 1 (count (get by-type "done"))))
(t/is (nil? (get by-type "error")))))
(finally
(restore-fetch)
(restore-port)
(await (fsp/rm tmpdir #js {:recursive true :force true})))))))
(t/deftest ^:async handle-render-posts-the-error-never-rejects
(let [posts (atom [])
restore-port (install-port posts)
restore-fetch (install-fetch (fn [_uri _opts]
(js/Promise.reject (js/Error. "backend down"))))]
(try
(await (worker/handle-render #js {:type "render"
:params (transit/encode-str
(test-params (os/tmpdir)))
:cancel nil}))
(let [by-type (group-by #(get % "type") @posts)]
(t/is (nil? (get by-type "done")))
(t/is (= 1 (count (get by-type "error"))))
(t/is (str/includes? (get (first (get by-type "error")) "message")
"http fetch failed")))
(finally
(restore-fetch)
(restore-port)))))

89
exporter/test/exporter_tests/jobs_test.cljs
View File

@ -1,89 +0,0 @@
;; 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 exporter-tests.jobs-test
"The local arm of the claimed job: the flag and the pieces a hard
cancel needs. The row of the job is the backend's business; nothing
here touches it."
(:require
[app.common.uuid :as uuid]
[app.jobs :as jobs]
[cljs.test :as t :include-macros true]))
(defn- register
[]
(let [job-id (uuid/next)]
(jobs/register job-id)
job-id))
(t/deftest mark-cancelled-runs-the-cancel-pieces-once
(t/testing "the signal arms, the callbacks run, and a second mark is a no-op"
(t/async done
(let [job-id (register)
seen (atom [])]
(jobs/on-cancel job-id (fn [] (swap! seen conj :first)))
(jobs/on-cancel job-id (fn [] (swap! seen conj :second)))
(t/is (true? (jobs/mark-cancelled job-id)))
(t/is (true? (jobs/cancelled? job-id)))
(t/is (some? (jobs/cancel-signal job-id)))
;; the signal is armed: a render thread reading it stops
(let [^js signal (jobs/cancel-signal job-id)]
(t/is (= 1 (js/Atomics.load signal 0))))
(t/is (= [:first :second] @seen))
;; a settled job is a no-op: nothing marked, nobody new called
(t/is (nil? (jobs/mark-cancelled job-id)))
(t/is (= [:first :second] @seen))
(done)))))
(t/deftest the-callbacks-see-the-cancelled-flag
;; a callback that stops the in-flight render reads the flag first: the
;; terminate of the worker is what a hard-cancel is for, and the pieces
;; below it must not race the writer
(t/async done
(let [job-id (register)
seen (atom ::not-called)]
(jobs/on-cancel job-id (fn [] (reset! seen (jobs/cancelled? job-id))))
(jobs/mark-cancelled job-id)
(t/is (true? @seen))
(done))))
(t/deftest a-signal-created-after-the-mark-is-armed
(t/testing "a job cancelled before its render leased a worker is
already stoppable for the render that comes next"
(t/async done
(let [job-id (register)]
(jobs/mark-cancelled job-id)
(let [^js signal (jobs/cancel-signal job-id)]
(t/is (some? signal))
(t/is (= 1 (js/Atomics.load signal 0))))
(done)))))
(t/deftest writes-stop-once-the-job-is-released
(t/testing "a late cancel for a settled job changes nothing, and
release drops every piece"
(t/async done
(let [job-id (register)
seen (atom ::not-called)]
(jobs/on-cancel job-id (fn [] (reset! seen :callback-ran)))
(jobs/release job-id)
(t/is (nil? (jobs/mark-cancelled job-id)))
(t/is (= ::not-called @seen))
(t/is (false? (jobs/cancelled? job-id)))
(t/is (nil? (jobs/cancel-signal job-id)))
(done)))))
(t/deftest an-unowned-job-is-a-no-op
(t/testing "mark and pieces for a job this process never registered"
(t/async done
(let [job-id (uuid/next)]
(t/is (nil? (jobs/mark-cancelled job-id)))
(t/is (false? (jobs/cancelled? job-id)))
(t/is (nil? (jobs/cancel-signal job-id)))
(done)))))

14
exporter/test/exporter_tests/main_test.cljs
View File

@ -12,9 +12,9 @@
["node:path" :as path]
["node:process" :as proc]
[app.common.logging :as l]
[app.config :as cf]
[cljs.test :as t :include-macros true]
[exporter.browser :as browser]
[exporter.config :as cf]
[exporter.consumer.config :as ccfg]
[exporter.main :as main]
[exporter.utils.system :as system]))
@ -59,7 +59,8 @@
:base-uri "http://internal/"
:public-uri "http://public/"
:svgo? false}
:exporter/tmpdir {:path (path/join (os/tmpdir) "penpot-exporter-test")}})
:exporter/tmpdir {:path (path/join (os/tmpdir) "penpot-exporter-test")
:job-ttl 3600}})
(defn- pool-of
[]
@ -106,7 +107,11 @@
(t/is (= {:exporter.browser/pool (system/ref :exporter.browser/pool)
:exporter.wasm/pool (system/ref :exporter.wasm/pool)}
(select-keys renderer
[:exporter.browser/pool :exporter.wasm/pool])))))
[:exporter.browser/pool :exporter.wasm/pool])))
(t/is (= (cf/get-internal-uri) (:base-uri renderer)))
(t/is (= (cf/get :public-uri) (:public-uri renderer)))
(t/is (= cf/management-key (:management-key renderer)))
(t/is (= (cf/get :wasm-worker-image-cache-size) (:image-cache-size renderer)))))
(t/testing "the queue consumer names the renderer it renders through"
(let [worker (:exporter.consumer/worker main/system-config)]
(t/is (= (ccfg/concurrency) (:concurrency worker)))
@ -114,7 +119,8 @@
(t/is (= (system/ref :exporter/renderer) (:renderer worker)))
(t/is (= (system/ref :exporter/tmpdir) (:exporter/tmpdir worker)))))
(t/testing "the temp area is wired from the environment"
(t/is (= {:path (cf/get :tempdir)}
(t/is (= {:path (cf/get :tempdir)
:job-ttl (cf/get :exporter-job-ttl 3600)}
(:exporter/tmpdir main/system-config)))))
;; NOTE: no test boots the production wiring: the wasm pool warms one

2
exporter/test/exporter_tests/renderer_browser_test.cljs
View File

@ -12,9 +12,9 @@
["generic-pool" :as gp]
["node:os" :as os]
[app.common.uuid :as uuid]
[app.config :as cf]
[cljs.test :as t :include-macros true]
[clojure.string :as str]
[exporter.config :as cf]
[exporter.renderer.browser :as render]
[exporter.renderer.svg-gradient :as grad]
[exporter.shell :as shell]))

38
exporter/test/exporter_tests/renderer_test.cljs
View File

@ -14,8 +14,8 @@
["node:os" :as os]
[app.common.transit :as transit]
[app.common.uuid :as uuid]
[app.config :as cf]
[cljs.test :as t :include-macros true]
[exporter.config :as cf]
[exporter.renderer :as renderer]))
;; --- stub browser side (bitmap only: navigate once, shoot objects) ---
@ -97,6 +97,8 @@
:exporter/tmpdir (os/tmpdir)
:base-uri (cf/get-internal-uri)
:public-uri (cf/get :public-uri)
:management-key "mgmt-key"
:image-cache-size 100
:svgo? false
:exporter.wasm/pool {:pool (stub-wasm-pool calls worker) :timeout-ms 5000}}))
@ -149,6 +151,40 @@
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))
(t/deftest ^:async render-posts-the-render-env-to-the-worker
;; Everything the worker thread needs beyond the export itself
;; travels in the posted params: the worker reads no config and no
;; globals, so the lease message carries the render env.
(try
(let [calls (atom [])
posted (atom nil)
worker (let [^js emitter (events/EventEmitter.)]
(unchecked-set emitter "postMessage"
(fn [msg]
(reset! posted msg)
(js/setTimeout
(fn [] (.emit emitter "message" #js {:type "done"}))
0)))
(unchecked-set emitter "terminate"
(fn [] (js/Promise.resolve nil)))
emitter)
cfg (assoc (test-cfg calls)
:exporter.wasm/pool {:pool (stub-wasm-pool calls worker)
:timeout-ms 5000})]
(await ((renderer/render-fn cfg)
{:exports [(test-params :png {:is-wasm true})]
:on-object (fn [_] nil)
:check-cancelled (never-cancelled calls)}))
(let [params (transit/decode-str (unchecked-get @posted "params"))
env (:exporter.wasm.render/env params)]
(t/is (= (cf/get-internal-uri) (:internal-uri env)))
(t/is (= (cf/get :public-uri) (:public-uri env)))
(t/is (= "mgmt-key" (:management-key env)))
(t/is (= (os/tmpdir) (:tmpdir env)))
(t/is (= 100 (:image-cache-size env)))))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))
(t/deftest ^:async render-rejects-invalid-params
(try
(let [calls (atom [])]

32
exporter/test/exporter_tests/runner.cljs
View File

@ -10,30 +10,30 @@
[cljs.test :as t]
[clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]]
[exporter-tests.api-test]
[exporter-tests.browser-scope-test]
[exporter-tests.browser-test]
[exporter-tests.consumer-api-test]
[exporter-tests.consumer-config-test]
[exporter-tests.consumer-plan-test]
[exporter-tests.consumer-test]
[exporter-tests.consumer-worker-test]
[exporter-tests.exporter-config-test]
[exporter-tests.exporter-consumer-config-test]
[exporter-tests.exporter-consumer-plan-test]
[exporter-tests.exporter-jobs-test]
[exporter-tests.exporter-resources-test]
[exporter-tests.exporter-shell-test]
[exporter-tests.jobs-test]
[exporter-tests.exporter-tmpdir-test]
[exporter-tests.exporter-util-mime-test]
[exporter-tests.exporter-util-object-test]
[exporter-tests.exporter-wasm-render-test]
[exporter-tests.exporter-wasm-svg-test]
[exporter-tests.exporter-wasm-worker-test]
[exporter-tests.main-test]
[exporter-tests.renderer-browser-test]
[exporter-tests.renderer-svg-test]
[exporter-tests.renderer-test]
[exporter-tests.renderer-wasm-test]
[exporter-tests.shell-test]
[exporter-tests.system-test]
[exporter-tests.wasm-pool-service-test]
[exporter-tests.wasm-pool-test]
[exporter-tests.wasm-scope-test]
[exporter-tests.worker-test]
[goog.object :as gobj]))
(enable-console-print!)
@ -49,26 +49,26 @@
['exporter-tests.browser-scope-test
'exporter-tests.browser-test
'exporter-tests.consumer-api-test
'exporter-tests.consumer-plan-test
'exporter-tests.consumer-test
'exporter-tests.consumer-worker-test
'exporter-tests.exporter-config-test
'exporter-tests.exporter-consumer-config-test
'exporter-tests.exporter-consumer-plan-test
'exporter-tests.exporter-jobs-test
'exporter-tests.exporter-resources-test
'exporter-tests.exporter-shell-test
'exporter-tests.jobs-test
'exporter-tests.exporter-tmpdir-test
'exporter-tests.exporter-util-mime-test
'exporter-tests.exporter-util-object-test
'exporter-tests.exporter-wasm-render-test
'exporter-tests.exporter-wasm-svg-test
'exporter-tests.exporter-wasm-worker-test
'exporter-tests.main-test
'exporter-tests.api-test
'exporter-tests.worker-test
'exporter-tests.consumer-config-test
'exporter-tests.renderer-browser-test
'exporter-tests.renderer-svg-test
'exporter-tests.renderer-test
'exporter-tests.renderer-wasm-test
'exporter-tests.shell-test
'exporter-tests.system-test
'exporter-tests.wasm-pool-service-test
'exporter-tests.wasm-pool-test
'exporter-tests.wasm-scope-test])
(assert (every? find-ns-obj test-namespaces)

70
exporter/test/exporter_tests/shell_test.cljs
View File

@ -1,70 +0,0 @@
;; 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 exporter-tests.shell-test
"Tests to verify GHSA-4f36-m4hj-cv86 is fixed: OS Command Injection in SVG exporter.
These tests prove that:
1. execFile does NOT interpret shell metacharacters (safe execution)
2. Malicious colors fail validation regex
3. The injection does NOT execute commands (no RCE)"
(:require
["node:child_process" :as proc]
["node:fs" :as fs]
[cljs.test :as t :include-macros true]))
(def ^:private hex-color-rx
#"^#(?:[0-9a-fA-F]{3}){1,2}$")
(defn- valid-hex-color?
[color]
(and (string? color)
(some? (re-matches hex-color-rx color))))
(t/deftest execfile-does-not-interpret-shell-metacharacters
(t/testing "Proves execFile passes arguments literally (no shell interpretation)"
(t/async done
(let [cmd "echo"
args #js ["$(echo PWNED)"]]
(proc/execFile cmd args #js {:encoding "buffer"}
(fn [error stdout _stderr]
(if error
(do
(t/is false (str "unexpected error: " (.-message error)))
(done))
(let [output (.toString stdout "utf8")]
(t/is (= "$(echo PWNED)\n" output)
"execFile passes $(...) literally, no shell interpretation")
(done)))))))))
(t/deftest malicious-color-fails-validation
(t/testing "Proves malicious colors are rejected by validation"
(let [malicious "#000000$(echo PWNED)"
valid-color "#000000"
short-valid "#abc"]
(t/is (not (valid-hex-color? malicious))
"malicious color with $(...) fails validation")
(t/is (valid-hex-color? valid-color)
"valid 6-digit hex color passes validation")
(t/is (valid-hex-color? short-valid)
"valid 3-digit hex color passes validation"))))
(t/deftest execfile-does-not-execute-injected-commands
(t/testing "Proves execFile does NOT execute injected commands (no RCE)"
(t/async done
(let [marker "/tmp/penpot-exporter-rce-test"
malicious (str "#000000$(touch " marker ")")
cmd "echo"
args #js [malicious]]
(when (fs/existsSync marker)
(fs/unlinkSync marker))
(proc/execFile cmd args #js {:encoding "buffer"}
(fn [_error _stdout _stderr]
;; Command completes (or fails), but no injection occurs
(t/is (not (fs/existsSync marker))
"no RCE: marker file was NOT created")
(when (fs/existsSync marker)
(fs/unlinkSync marker))
(done)))))))

46
exporter/test/exporter_tests/wasm_pool_test.cljs
View File

@ -1,46 +0,0 @@
;; 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 exporter-tests.wasm-pool-test
"Worker leasing, against a stub pool: `with-worker` must give the worker back
however its body ends."
(:require
[app.wasm.pool :as pool]
[cljs.test :as t :include-macros true]
[promesa.core :as p]))
(defn- stub-pool
"Installs a pool whose acquire/release/destroy only count calls."
[]
(let [calls (atom {:acquired 0 :released 0 :destroyed 0})]
(reset! pool/pool
#js {:acquire (fn [] (swap! calls update :acquired inc) (p/resolved ::worker))
:release (fn [_] (swap! calls update :released inc) (p/resolved nil))
:destroy (fn [_] (swap! calls update :destroyed inc) (p/resolved nil))})
calls))
(t/deftest releases-the-worker-when-the-body-succeeds
(t/async done
(let [calls (stub-pool)]
(p/let [result (pool/with-worker (fn [_] (p/resolved :ok)))]
(t/is (= :ok result))
(t/is (= 1 (:acquired @calls)))
(t/is (= 1 (:released @calls)))
(t/is (= 0 (:destroyed @calls)))
(reset! pool/pool nil)
(done)))))
(t/deftest gives-the-worker-back-when-the-body-throws-synchronously
(t/testing "a raise out of the scope body must not leave the worker borrowed"
(t/async done
(let [calls (stub-pool)]
(->> (pool/with-worker (fn [_] (throw (ex-info "cancelled" {}))))
(p/hmap (fn [_ cause]
(t/is (some? cause))
(t/is (= 1 (:acquired @calls)))
(t/is (= 1 (+ (:released @calls) (:destroyed @calls))))
(reset! pool/pool nil)
(done))))))))

385
exporter/test/exporter_tests/worker_test.cljs
View File

@ -1,385 +0,0 @@
;; 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 exporter-tests.worker-test
"The queue loop of the worker: the payload it reads, the claim it
makes, and one settled export end to end, over a fake redis queue and
a fake management http. The e2e against the real backend is Task 8's
business in devenv; this harness pins the shapes the worker owns."
(:require
["node:fs/promises" :as fsp]
["undici" :as http]
[app.common.exceptions :as ex]
[app.common.transit :as transit]
[app.common.uuid :as uuid]
[app.consumer.api :as api]
[app.consumer.exports :as exports]
[app.consumer.worker :as worker]
[app.renderer :as rd]
[app.util.shell :as sh]
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]
[promesa.core :as p]))
;; ---- THE MANAGEMENT FAKE
(def ^:private calls
"One entry per management call: [method, body]."
(atom []))
(defn- method-of
"The management method the client asked for."
[uri]
(last (str/split (str uri) "/")))
(defn- steps-of
"The sequence of management methods the run went by."
[]
(mapv first @calls))
(defn- call-of
"The body of the first call of one method."
[method]
(some (fn [[m body]]
(when (= m method) body))
@calls))
(defn- fake-fetch
"Installs a management http fake: `respond` answers with the `:action`
envelope per [method, body] (the multipart arrives as a FormData
instance). Every call lands in `calls` before the answer. Returns the
restore thunk."
[respond]
(reset! calls [])
(let [original api/fetch]
(set! api/fetch
(fn [uri request]
(let [method (method-of uri)
body (if (instance? http/FormData (.-body request))
(.-body request)
(transit/decode-str (.-body request)))]
(swap! calls conj [method body])
(p/resolved #js {:status 200
:text (constantly
(p/resolved (transit/encode-str
(respond method body))))}))))
(fn [] (set! api/fetch original))))
;; ---- THE RD FAKE
(defn- fake-render
"Installs a fake renderer that writes one file of `content` per
object and calls back with it. When `captured` is an atom, it also
keeps the params of the last render. Returns the restore thunk."
([content] (fake-render content nil))
([content captured]
(let [original rd/render]
(set! rd/render
(fn [params on-object]
(when (some? captured)
(reset! captured params))
(p/let [rendered-path (sh/tempfile :prefix "penpot.render."
:suffix ".png")
_ (fsp/writeFile rendered-path content)]
(on-object {:path rendered-path
:filename "rendered.png"})
(p/resolved nil))))
(fn [] (set! rd/render original)))))
(defn- fake-render-fail
"A renderer that always fails: the failure path of the run."
[]
(let [original rd/render]
(set! rd/render (fn [_params _on-object]
(p/rejected (ex-info "render boom" {}))))
(fn [] (set! rd/render original))))
;; ---- THE QUEUE FAKE
(defn- fake-conn
"A fake ioredis connection: `blpop` pops one payload from the queue
the atom holds, or nil."
[queue]
#js {:blpop (fn [_key _timeout-s]
(if-let [payload (first @queue)]
(do
(swap! queue rest)
(p/resolved #js ["the.queue.key" payload]))
(p/resolved nil)))})
;; ---- THE FIXTURE
(defn- export-params
"Params of a one-shape png job, in the job-def shape, the way the
claim carries them: the type as text."
[]
{:exports [{:file-id (str (uuid/next))
:page-id (str (uuid/next))
:object-id (str (uuid/next))
:type "png"
:name "test shape"
:suffix ""
:scale 1}]
:name "the export"})
(defn- encoded-claim
"The JSON payload the dispatcher pushes."
[job-id scheduled-at]
(js/JSON.stringify #js [(str job-id) scheduled-at]))
(defn- answer-with
"The management answers of a run: the claim gives the run away to
this poller with the params of the job, the session mints a real
one, every report and settle answers run. The `stages` atom records
every report's stage (they travel wrapped in `:progress`)."
[params sid stages]
(fn [method body]
(when (= method "report-job-progress")
(vswap! stages conj (get-in body [:progress :stage])))
(case method
"claim-job" {:action :run :name "export-assets" :params params}
"create-job-session" {:session-id sid :session-token "session-token"}
{:action :run})))
(defn- run-claim
"The claim payload of one call of `process`."
[job-id]
{:job-id job-id
:scheduled-at "2026-10-07T09:00:00Z"})
(t/deftest read-decodes-the-dispatcher-payload
(t/testing "a payload in shape names the job and when it was pushed"
(let [job-id (uuid/next)]
(t/is (= {:job-id (str job-id)
:scheduled-at "2026-10-07T09:00:00Z"}
(worker/read-payload (encoded-claim job-id
"2026-10-07T09:00:00Z"))))))
(t/testing "a corrupt payload is dropped, not thrown at the loop"
(t/is (nil? (worker/read-payload "{not a payload")))))
(t/deftest process-hands-the-renderer-uuids-not-claim-strings
;; the claim carries the job row JSON: every id a string. The render
;; spec wants uuid objects (and a nil job-id never renders), so the
;; run parses them before the first render.
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
share-id (uuid/next)
params {:exports [{:file-id (str (uuid/next))
:page-id (str (uuid/next))
:object-id (str (uuid/next))
:share-id (str share-id)
:type "png"
:name "test shape"
:suffix ""
:scale 1}]
:name "the export"}
stages (volatile! [])
captured (atom nil)
fetch-restore (fake-fetch (answer-with params sid stages))
render-restore (fake-render "rendered!" captured)]
(p/let [_ (worker/process {:job-id (str job-id)
:scheduled-at "2026-10-07T09:00:00Z"})]
(let [render-params @captured]
(t/testing "every id arrived as a uuid object"
(t/is (uuid? (:file-id render-params)))
(t/is (uuid? (:page-id render-params)))
(t/is (uuid? (:share-id render-params)))
(t/is (= share-id (:share-id render-params)))
(t/is (uuid? (-> render-params :objects first :id))))
(t/testing "and the job-id traveled with the render"
(t/is (= job-id (:job-id render-params)))))
(fetch-restore)
(render-restore)
(done)))))
(t/deftest poll-once-awaits-what-it-claims
(t/async done
(let [queue (atom [(encoded-claim (uuid/next) "2026-10-07T09:00:00Z")])
conn (fake-conn queue)
handled (atom [])]
(p/let [_ (worker/poll-once conn
"the.queue.key"
(fn [claim] (swap! handled conj claim)))]
(t/is (= 1 (count @handled)))
(done)))))
(t/deftest poll-once-drops-empty-pops-and-corrupt-payloads
(t/async done
(let [queue (atom ["{corrupt"])
conn (fake-conn queue)]
(p/let [_ (worker/poll-once conn
"the.queue.key"
(fn [_claim]
(t/is false "corrupt must not be handled")))
_ (worker/poll-once conn
"the.queue.key"
(fn [_claim]
(t/is false "a corrupt pop has nothing to handle")))]
(t/is (empty? @queue))
(done)))))
(t/deftest process-drops-a-claim-the-worker-never-won
(t/async done
(let [fetch-restore (fake-fetch
(fn [method _body]
(case method
"claim-job" {:action :skip :status "cancelled"}
{:action :run})))
render-restore (fake-render "should never render")]
(p/let [settled (worker/process
{:job-id (uuid/next)
:scheduled-at "2026-10-07T09:00:00Z"})]
(t/testing "only the claim traveled: no session, no report, no render"
(t/is (= ["claim-job"] (steps-of)))
(t/is (nil? settled)))
(fetch-restore)
(render-restore)
(done)))))
(t/deftest process-runs-the-claimed-export-to-a-multipart-settle
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
params (export-params)
stages (volatile! [])
fetch-restore (fake-fetch (answer-with params sid stages))
render-restore (fake-render "rendered!")]
(p/let [_ (worker/process (run-claim job-id))]
(t/testing "the run went by claim, first breath, session, beats, settle"
(t/is (= ["claim-job" "report-job-progress" "create-job-session"
"report-job-progress" "report-job-progress"
"complete-job"]
(steps-of))))
(t/testing "the settle carried the real artifact, named and typed"
(let [fd (call-of "complete-job")]
(t/is (instance? http/FormData fd))
(t/is (= (str job-id) (.get fd "job-id")))
(t/is (= (str sid) (.get fd "session-id")))
(t/is (= "image/png" (.get fd "mtype")))))
(t/testing "the beats painted the vocabulary in order"
(t/is (= [:preparing :rendering :packaging] @stages)))
(fetch-restore)
(render-restore)
(done)))))
(t/deftest cancelled-is-a-normal-ending-not-a-failure
(t/testing "the cooperative cancel classifies as cancelled"
(t/is (true? (exports/cancelled?
(ex/error :type :internal
:code :job-cancelled
:hint "export job was cancelled")))))
(t/testing "anything else is a failure"
(t/is (false? (exports/cancelled? (ex-info "render boom" {}))))))
(t/deftest a-failed-run-stops-beating-after-the-settle
;; the watchdog interval belongs to the run: if the failure path
;; does not clear it, it beats on a dead job forever — one HTTP call
;; a second that only ever answers skip
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
params (export-params)
stages (volatile! [])
fetch-restore (fake-fetch (answer-with params sid stages))
render-restore (fake-render-fail)]
(p/let [_ (worker/process (run-claim job-id))
_ (p/delay 1400)]
(t/testing "no beat traveled after the fail settle"
(t/is (= "fail-job" (last (steps-of)))))
(fetch-restore)
(render-restore)
(done)))))
(t/deftest process-settles-a-failed-export-with-fail-job
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
params (export-params)
stages (volatile! [])
fetch-restore (fake-fetch (answer-with params sid stages))
render-restore (fake-render-fail)]
(p/let [_ (worker/process (run-claim job-id))]
(t/testing "the settle was a fail, not a complete"
(t/is (= "fail-job" (last (steps-of)))))
(t/testing "the failure is the shape the backend stores"
(let [fail (call-of "fail-job")]
(t/is (= :internal (get-in fail [:error :type])))
(t/is (= :export-failed (get-in fail [:error :code])))
(t/is (= "render boom" (get-in fail [:error :hint])))
(t/is (= sid (:session-id fail)))))
(fetch-restore)
(render-restore)
(done)))))
;; ---- THE CANCEL
(t/deftest cancel-runs-the-cancel-port
;; the beat the backend refuses (a skip) is the cancel arriving: the
;; port runs exactly once, the local flag says cancelled and the
;; runner unwinds; the settle below is the backend's own row, not a
;; new answer of this worker
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
params (export-params)
stages (volatile! [])
fetch-restore (fake-fetch
(fn [method body]
(when (= "report-job-progress" method)
(vswap! stages conj (get-in body [:progress :stage])))
(case method
"claim-job" {:action :run :name "export-assets" :params params}
"create-job-session" {:session-id sid :session-token "session-token"}
"report-job-progress" {:action :skip}
{:action :run})))]
(p/let [_ (worker/process (run-claim job-id))]
(t/testing "the settle of a cancelled job was a fail the backend answers skip"
(t/is (= "fail-job" (last (steps-of))))
(let [fail (call-of "fail-job")]
(t/is (= :job-cancelled (get-in fail [:error :code])))))
(fetch-restore)
(done)))))
(t/deftest cancel-kills-the-mid-skia-render
;; the watchdog is what makes the cancel seen while the thread renders;
;; the port it fires is the one renderer.wasm/with-scope registered,
;; which terminates the worker
(t/async done
(let [job-id (uuid/next)
sid (uuid/next)
params (export-params)
stages (volatile! [])
fetch-restore (fake-fetch
(fn [method body]
(when (= "report-job-progress" method)
(vswap! stages conj (get-in body [:progress :stage])))
(case method
"claim-job" {:action :run :name "export-assets" :params params}
"create-job-session" {:session-id sid :session-token "session-token"}
;; the first beat runs, everything else skips:
;; the cancel lands right after the claim
"report-job-progress" (if (empty? @stages)
{:action :run}
{:action :skip})
{:action :run})))
render-restore (let [original rd/render]
(set! rd/render
(fn [_params _on-object]
;; never resolves: the render only ends
;; when its thread is terminated, and the
;; registry entry the with-scope registered
;; does not exist in this fake
(p/delay 30000)))
(fn [] (set! rd/render original)))]
(p/let [_ (worker/process (run-claim job-id))]
(t/testing "the run ended in a fail job, not a complete"
(t/is (= "fail-job" (last (steps-of)))))
(render-restore)
(fetch-restore)
(done)))))

2
render-wasm/README.md
View File

@ -83,7 +83,7 @@ Use the target cleanup commands instead of running `cargo clean` on the shared
Each target writes its own generated `shared.js` (the enum discriminants the
CLJS side compiles against) next to the code that imports it — respectively
`frontend/src/app/render_wasm/api/shared.js` and
`exporter/src/app/wasm/shared.js`. Neither build writes to the other's paths.
`exporter/src/exporter/wasm/shared.js`. Neither build writes to the other's paths.
![Architecture overview](docs/images/architecture_schema.png)

2
render-wasm/_build_env
View File

@ -99,7 +99,7 @@ export FRONTEND_DEST="../frontend/resources/public/js";
export EXPORT_DEST="../exporter/resources/wasm";
export FRONTEND_SHARED_DEST="../frontend/src/app/render_wasm/api/shared.js";
export EXPORT_SHARED_DEST="../exporter/src/app/wasm/shared.js";
export EXPORT_SHARED_DEST="../exporter/src/exporter/wasm/shared.js";
function clean {
cargo clean;