diff --git a/.clj-kondo/config.edn b/.clj-kondo/config.edn index af4647fb4..f0070b8dd 100644 --- a/.clj-kondo/config.edn +++ b/.clj-kondo/config.edn @@ -3,7 +3,25 @@ :exclude-files "resources/public/js/compiled" :output {:exclude-files [".*resources/public/js/compiled.*" ".*docker/scripts/.*"]} - :linters {;; Enabled at :warning so NEW accidental shadows are caught. + :linters {;; A BLANK ENVIRONMENT VALUE IS AN ABSENT ONE, and (or (env :k) default) + ;; does not implement that: environ returns "" for an exported-but-empty + ;; variable and "" is truthy, so the default never applies. That shape + ;; was written independently at five sites and cost, among others, JWTs + ;; signed and verified against the empty string. + ;; + ;; orcpub.config already had a correct accessor and routes.clj read + ;; (environ/env :signature) raw anyway, four times -- which is why this + ;; is a lint rule and not just a helper. Read through orcpub.env/value. + ;; :error, not :warning -- `lein lint` runs with --fail-level error, so + ;; this is the difference between a rule and a suggestion. The helper + ;; it points at already existed once and was bypassed. + :discouraged-var + {:level :error + environ.core/env + {:message "Use orcpub.env/value -- (or (env :k) d) treats an empty value as set. See orcpub.env."} + java.lang.System/getenv + {:message "Use orcpub.env/value -- environ already reads env vars, and this skips the blank check."}} + ;; Enabled at :warning so NEW accidental shadows are caught. ;; :exclude covers established patterns: core vars used as param names ;; (name, key, type, etc.) and domain terms used as both defs and params ;; (level, ability, armor, etc.) across modifier/option/character code. @@ -107,10 +125,21 @@ (orcpub.routes-test/with-conn) (orcpub.routes.folder-test/with-conn) (orcpub.email-change-test/with-conn) + (orcpub.registration-rollback-test/with-conn) (user/with-db)]}} ;; native/cljs and web/cljs are separate source roots; kondo doesn't know ;; about them so ns names appear to mismatch their file paths. - :config-in-ns {orcpub.core {:linters {:namespace-name-mismatch {:level :off}}} + ;; orcpub.env is the one place allowed to read the environment; the whole + ;; point of the namespace is to be the single exception. + :config-in-ns {orcpub.env {:linters {:discouraged-var {:level :off}}} + ;; These two STUB environ.core/env with with-redefs, which is how + ;; you test the accessor and the locale behaviour at all -- kondo + ;; counts the var reference as a use. Exempted by namespace rather + ;; than for all of test/, so an ordinary bare read in a test is + ;; still an error (routes_test.clj had one). + orcpub.env-test {:linters {:discouraged-var {:level :off}}} + orcpub.config-test {:linters {:discouraged-var {:level :off}}} + orcpub.core {:linters {:namespace-name-mismatch {:level :off}}} orcpub.views {:linters {:namespace-name-mismatch {:level :off}}} orcpub.dnd.e5.native-views {:linters {:namespace-name-mismatch {:level :off}}}} ;; with-conn macros use bare symbol bindings — handled via diff --git a/.env.example b/.env.example index 9516f341e..4081a1d4c 100644 --- a/.env.example +++ b/.env.example @@ -28,7 +28,22 @@ TZ=America/Chicago # Old URLs with ?password= still work — the embedded password takes priority. ADMIN_PASSWORD=change-me-admin DATOMIC_PASSWORD=change-me-datomic -DATOMIC_URL=datomic:dev://datomic:4334/orcpub +# Left COMMENTED OUT on purpose, so that each way of running picks its own +# correct value instead of inheriting the other's: +# +# bare metal -> config.clj/default-datomic-uri = datomic:dev://localhost:4334/orcpub +# docker -> docker-compose.yaml already defaults it to the "datomic" +# service hostname, which only resolves inside that network +# +# Setting it here would defeat both. Compose reads this .env for substitution, +# so an uncommented localhost would override compose's own default and break +# the container; an uncommented "datomic" hostname breaks every non-Docker +# install, which is how it used to ship. +# +# Uncomment ONLY for a database somewhere else -- a remote transactor, a +# non-default port, or Datomic SQL storage: +# DATOMIC_URL=datomic:dev://localhost:4334/orcpub +# DATOMIC_URL=datomic:sql://orcpub?jdbc:postgresql://db:5432/datomic # --- Transactor Tuning --- # These rarely need changing. See docker/transactor.properties.template. @@ -48,8 +63,11 @@ SIGNATURE=change-me-to-something-unique-and-long # Content Security Policy (strict|permissive|none) CSP_POLICY=strict -# Dev mode: CSP violations are logged (Report-Only) instead of blocked, -# allowing Figwheel hot-reload scripts to execute. +# Dev mode: no CSP header is sent at all, so Figwheel's scripts and its +# websocket (ws://localhost:3449) work. Leave this true for development. +# With DEV_MODE unset or false, CSP_POLICY=strict sends an ENFORCING policy +# whose connect-src does not include the Figwheel socket, and hot reload is +# blocked with no obvious cause. # Must be the string "true" (case-insensitive). Any other value is treated as false. DEV_MODE=true @@ -72,16 +90,31 @@ LOG_DIR= # FIGWHEEL_CONNECT_URL= # --- Email (SMTP) --- -# Leave EMAIL_SERVER_URL empty to disable email functionality +# EMAIL_SERVER_URL empty means this deployment cannot send mail, and registration +# then REFUSES to create accounts -- deliberately, because a dropped or typo'd +# value would otherwise silently turn a public site into open registration. +# +# To actually run without email, say so: ALLOW_UNVERIFIED_REGISTRATION=true. +# Accounts are then verified on creation and no mail is ever sent. Only sensible +# for a private instance where you hand out the accounts, since nobody proves +# they own the address they typed. EMAIL_SERVER_URL= EMAIL_ACCESS_KEY= EMAIL_SECRET_KEY= EMAIL_SERVER_PORT=587 -EMAIL_FROM_ADDRESS= +# MUST be an address your SMTP provider is authorised to send as (SPF/DKIM), +# not just any address you own. Left blank it falls back to +# branding/email-from-address (no-reply@orcpub.com), which your provider +# almost certainly will not accept -- set it. +EMAIL_FROM_ADDRESS=no-reply@example.com EMAIL_ERRORS_TO= EMAIL_SSL=FALSE EMAIL_TLS=FALSE +# Accept registrations without verifying the address. Requires EMAIL_SERVER_URL +# to be empty; ignored otherwise. Private instances only. +ALLOW_UNVERIFIED_REGISTRATION=false + # --- Branding (optional) --- # Override app identity for forks. All have sensible defaults in fork/branding.clj. # APP_NAME=Dungeon Master's Vault diff --git a/.github/workflows/locale.yml b/.github/workflows/locale.yml new file mode 100644 index 000000000..9fa24cef1 --- /dev/null +++ b/.github/workflows/locale.yml @@ -0,0 +1,61 @@ +# Runs the JVM suite under non-English locales. +# +# Everything the locale-safety work fixed was invisible to an English-locale CI: +# an unlocalised date formatter that blanked every webjar asset, CSP_POLICY +# folding to "strıct", name-to-kw producing :ıllusory-script, and two name +# searches returning nothing for an uppercase query. None of them fail under +# en_US, so en_US alone can never catch the next one. +# +# tr_TR is the high-value entry: Turkish and Azerbaijani are the only locales +# whose ASCII case folding differs, so they catch that whole class. es_ES +# catches date parsing, which tr_TR also catches -- one non-English entry would +# do, but es_ES is where the original bug report came from, so it stays as a +# named regression guard. + +name: Locale + +on: + push: + branches: [hotfix/locale-safety, develop, main] + pull_request: + branches: [develop, main] + workflow_dispatch: + +permissions: + contents: read + +jobs: + jvm-suite: + name: JVM suite under ${{ matrix.locale }} + runs-on: ubuntu-latest + timeout-minutes: 20 + strategy: + fail-fast: false + matrix: + include: + - locale: tr_TR + java_opts: -Duser.language=tr -Duser.country=TR + - locale: es_ES + java_opts: -Duser.language=es -Duser.country=ES + steps: + - uses: actions/checkout@v4 + + - uses: actions/setup-java@v4 + with: + distribution: temurin + java-version: '21' + + # Pinned to the version continuous-integration.yml uses. `stable` is a + # moving ref, so an upstream release could change or break this check. + - name: Install Leiningen + run: | + curl -fsSL -o "$HOME/lein" \ + https://raw.githubusercontent.com/technomancy/leiningen/2.11.2/bin/lein + chmod +x "$HOME/lein" + echo "$HOME" >> "$GITHUB_PATH" + "$HOME/lein" version + + - name: lein test + env: + JAVA_TOOL_OPTIONS: ${{ matrix.java_opts }} + run: lein test diff --git a/.github/workflows/windows-scripts.yml b/.github/workflows/windows-scripts.yml new file mode 100644 index 000000000..755c35dcb --- /dev/null +++ b/.github/workflows/windows-scripts.yml @@ -0,0 +1,272 @@ +# Validates the Windows/Git Bash assumptions the port-detection code is built +# on. Everything about the Windows path was reasoned about and tested against +# hand-written stubs — which is circular, because the same author wrote the stub +# and the parser. This runs it on a real Windows machine instead. +# +# Deliberately does NOT need Java, Leiningen or Datomic: it binds a port with +# python and asks the shell functions what they see. That keeps it ~1 minute so +# it can run on every push to the branch. +# +# It ASSERTS rather than reports. If an assumption is wrong, this job goes red. + +name: Windows scripts + +on: + push: + branches: [hotfix/locale-safety, develop, main] + pull_request: + branches: [develop, main] + workflow_dispatch: + +permissions: + contents: read + +jobs: + probe: + name: Git Bash platform facts + port detection + runs-on: windows-latest + timeout-minutes: 15 + defaults: + run: + shell: bash # on windows-latest this is Git Bash (MSYS2) + steps: + - name: Checkout + uses: actions/checkout@v4 + + # --------------------------------------------------------------------- + # FACTS — printed whether or not they match what we assumed + # --------------------------------------------------------------------- + - name: Platform and tool inventory + run: | + echo "uname -s : $(uname -s)" + echo "OSTYPE : ${OSTYPE:-}" + for t in lsof ss netstat tasklist taskkill netsh python; do + printf ' %-10s %s\n' "$t" "$(command -v "$t" 2>/dev/null || echo '(absent)')" + done + + - name: ASSERT uname reports MINGW/MSYS + run: | + case "$(uname -s)" in + MINGW*|MSYS*|CYGWIN*) echo "OK: $(uname -s)" ;; + *) echo "FAIL: is_windows() would not fire — uname says '$(uname -s)'"; exit 1 ;; + esac + + # There was an "ASSERT lsof and ss are absent" step here. It was wrong on + # its own terms: port_in_use tests is_windows FIRST, so the Windows branch + # is taken whether or not those tools exist, and their presence would not + # make it dead code. All the assertion really pinned was the contents of + # the runner image, so a routine image update would have failed a build + # that had nothing wrong with it. The platform assertion above and the + # real-listener tests below cover what actually matters. + + - name: ASSERT 'netstat -tln' fails and prints nothing to stdout + run: | + # This is THE load-bearing claim: the old code ran exactly this, threw + # stderr away, and read the empty stdout as "the port is free". + set +e + out="$(netstat -tln 2>/tmp/err.txt)"; rc=$? + err="$(cat /tmp/err.txt)" + echo "exit code : $rc" + echo "stdout : [$out]" + echo "stderr : [$err]" + if [ -n "$out" ]; then + echo "FAIL: netstat -tln produced stdout — this netstat understands GNU flags" + exit 1 + fi + echo "OK: stdout empty, so the old check reads every port as free" + + - name: Show real 'netstat -ano' output shape + run: netstat -ano | head -15 + + # --------------------------------------------------------------------- + # THE ACTUAL TEST — bind a port for real, then ask both implementations + # --------------------------------------------------------------------- + - name: Old vs new detection against a real listener + run: | + set -u + python -c " + import socket, time + s = socket.socket() + s.bind(('127.0.0.1', 8890)); s.listen(5) + time.sleep(180) + " & + LISTENER=$! + # trap, not a kill at the bottom: the SETUP FAIL below exits early, and + # a listener leaked from here is what made three later steps test the + # wrong process. + trap 'kill $LISTENER 2>/dev/null || true' EXIT + sleep 5 + + # independent truth: can we actually connect? + if (exec 3<>/dev/tcp/127.0.0.1/8890) 2>/dev/null; then + echo "truth : port 8890 IS listening" + else + echo "SETUP FAIL : could not bind 8890 on the runner"; exit 1 + fi + + old_port_in_use() { # verbatim from develop, pre-fix + local port="$1" + if command -v lsof >/dev/null 2>&1; then lsof -i ":${port}" >/dev/null 2>&1 + elif command -v ss >/dev/null 2>&1; then ss -tln 2>/dev/null | grep -q ":${port}\b" + elif command -v netstat >/dev/null 2>&1; then netstat -tln 2>/dev/null | grep -q ":${port}\b" + else timeout 1 bash -c "/dev/null; fi + } + + source scripts/common.sh # the fixed implementation + + old_port_in_use 8890 && O=in-use || O=free + port_in_use 8890 && N=in-use || N=free + PIDS="$(find_pids_by_port 8890)" + echo "old check : $O" + echo "new check : $N (fixed)" + echo "pids : ${PIDS:-}" + + fail=0 + [ "$N" = "in-use" ] || { echo "FAIL: fixed port_in_use missed a real listener"; fail=1; } + [ -n "${PIDS// /}" ] || { echo "FAIL: find_pids_by_port returned nothing"; fail=1; } + port_in_use 8891 && { echo "FAIL: reported an unused port as busy"; fail=1; } + [ "$O" = "free" ] && echo "CONFIRMED: the old check reports 'free' for a port that is in use" + exit $fail + + - name: ASSERT taskkill can stop a process we found by port + run: | + set -u + source scripts/common.sh + python -c " + import socket, time + s = socket.socket() + s.bind(('127.0.0.1', 8899)); s.listen(5) + time.sleep(180) + " & + LISTENER=$! + trap 'kill $LISTENER 2>/dev/null || true' EXIT + sleep 5 + PIDS="$(find_pids_by_port 8899)" + echo "found pids : ${PIDS:-}" + [ -n "${PIDS// /}" ] || { echo "FAIL: could not find the listener"; exit 1; } + for p in $PIDS; do signal_pid "$p" KILL || true; done + sleep 3 + STILL="$(find_pids_by_port 8899)" + if [ -n "${STILL// /}" ]; then + echo "FAIL: taskkill did not stop it (still $STILL)"; exit 1 + fi + echo "OK: signal_pid/taskkill stopped the process and freed the port" + + - name: Reserved port ranges (informational) + run: | + netsh interface ipv4 show excludedportrange protocol=tcp || true + echo "--- is 8890 inside a reserved range on this runner? ---" + netsh interface ipv4 show excludedportrange protocol=tcp 2>/dev/null | tr -d '\r' \ + | awk '$1 ~ /^[0-9]+$/ && $2 ~ /^[0-9]+$/ && 8890 >= $1 && 8890 <= $2 {print " RESERVED: " $1 "-" $2; found=1} + END { if (!found) print " not reserved here" }' + + - name: ASSERT repl_mode picks headless on Windows + run: | + set -u + source scripts/common.sh + m="$(repl_mode)" + echo "repl_mode : $m" + if [ "$m" != "headless" ]; then + echo "FAIL: Windows must not get the interactive REPL — it exits and kills the server" + exit 1 + fi + echo "OK: Windows takes the headless path" + + - name: ASSERT start.sh's own port guard sees a busy port + run: | + # This is what replaces a bespoke launcher: with port_in_use fixed, + # check_port_available detects the conflict, names the PID, and (when + # interactive) offers to stop it. CI is non-interactive, so the + # expected outcome is a clean refusal naming the port. + set -u + # Port 8891, not 8890: an earlier step in this job binds 8890 and holds + # it for 180s without stopping it. This listener would have failed to + # bind, the failure would have been invisible behind `&`, and the test + # would then have passed against THAT listener -- green without ever + # exercising the process it claims to create. + python -c " + import socket, time + s = socket.socket() + s.bind(('127.0.0.1', 8891)); s.listen(5) + time.sleep(120) + " & + LISTENER=$! + trap 'kill $LISTENER 2>/dev/null || true' EXIT + sleep 5 + # Prove the listener is actually ours before asserting anything on it. + (exec 3<>/dev/tcp/127.0.0.1/8891) 2>/dev/null \ + || { echo "SETUP FAIL: nothing listening on 8891"; exit 1; } + source scripts/common.sh + # check_port_available lives in start.sh, and start.sh cannot be run + # end to end here (it exits at the Leiningen prereq before reaching + # the port guard), so lift the real function body out and test that. + SCRIPT_DIR="$PWD/scripts" + source <(sed -n '/^check_port_available()/,/^}/p' scripts/start.sh) + set +e + out="$(check_port_available 8891 server false 2>&1)"; rc=$? + set -e + echo "$out" + echo "exit: $rc" + [ "$rc" -ne 0 ] || { echo "FAIL: guard allowed a busy port through"; exit 1; } + echo "$out" | grep -qi "in use" || { echo "FAIL: did not say the port was in use"; exit 1; } + echo "OK: the existing guard catches it — no separate launcher needed" + + - name: ASSERT explain_bind_failure names the holder + run: | + set -u + source scripts/common.sh + python -c " + import socket, time + s = socket.socket() + s.bind(('127.0.0.1', 8890)); s.listen(5) + time.sleep(60) + " & + LISTENER=$! + trap 'kill $LISTENER 2>/dev/null || true' EXIT + sleep 5 + (exec 3<>/dev/tcp/127.0.0.1/8890) 2>/dev/null \ + || { echo "SETUP FAIL: nothing listening on 8890"; exit 1; } + out="$(explain_bind_failure 8890 2>&1)" + echo "$out" + echo "$out" | grep -qi "already listening" || { echo "FAIL: did not identify the listener"; exit 1; } + echo "$out" | grep -qi "taskkill" || { echo "FAIL: did not give the Windows stop command"; exit 1; } + echo "OK: a bind failure is explained in place" + + - name: ASSERT signal_pid handles an MSYS pid, not just a Windows pid + run: | + # find_service_pids checks the PID FILE first, and that pid came from + # $! — an MSYS pid, which taskkill cannot see. Using taskkill alone + # would make stop.sh report success while the process kept running. + set -u + source scripts/common.sh + sleep 120 & + MSYS_PID=$! + echo "msys pid : $MSYS_PID" + pid_alive "$MSYS_PID" || { echo "FAIL: pid_alive cannot see an MSYS pid"; exit 1; } + signal_pid "$MSYS_PID" KILL || true + sleep 2 + if pid_alive "$MSYS_PID"; then + echo "FAIL: signal_pid did not stop an MSYS pid"; exit 1 + fi + echo "OK: both pid kinds are handled" + + - name: ASSERT explain_bind_failure stays quiet when the port is free + run: | + # lein exits non-zero for ordinary reasons, Ctrl+C included. Announcing + # a bind failure after a normal shutdown would be crying wolf. + set -u + source scripts/common.sh + # A port no other step touches. Every listener step now traps EXIT and + # kills its own, so 8890 should in fact be free here -- but this + # assertion is about silence on a free port, and it should not also be + # an implicit test of someone else's cleanup. + FREE_PORT=8123 + if port_in_use "$FREE_PORT"; then + echo "SETUP FAIL: $FREE_PORT is unexpectedly in use"; exit 1 + fi + out="$(explain_bind_failure "$FREE_PORT" 2>&1)" + echo "output: [$out]" + if [ -n "$out" ]; then + echo "FAIL: reported a bind failure for a port nothing is using"; exit 1 + fi + echo "OK: silent when there is no evidence of a port problem" diff --git a/README.md b/README.md index 04d216652..cc59bf2a2 100644 --- a/README.md +++ b/README.md @@ -273,7 +273,8 @@ Key variables: | `DATOMIC_URL` | Database connection string | `datomic:dev://localhost:4334/orcpub` | | `SIGNATURE` | JWT signing secret (**required**) | dev default in `.lein-env` | | `PORT` | Web server port | `8890` | -| `EMAIL_SERVER_URL` | SMTP server | (optional) | +| `EMAIL_SERVER_URL` | SMTP server — leave empty and nobody can sign up (see `ALLOW_UNVERIFIED_REGISTRATION`) | (optional) | +| `ALLOW_UNVERIFIED_REGISTRATION` | Let people sign up without confirming their email. Private sites only | `false` | | `CSP_POLICY` | Content Security Policy mode | `strict` | | `DEV_MODE` | Enable dev features | `true` in dev | diff --git a/docker-compose.yaml b/docker-compose.yaml index be568a6d9..2d4992e1a 100644 --- a/docker-compose.yaml +++ b/docker-compose.yaml @@ -54,6 +54,9 @@ services: SIGNATURE: ${SIGNATURE:-change-me-to-something-unique} CSP_POLICY: ${CSP_POLICY:-strict} DEV_MODE: ${DEV_MODE:-} + # Empty EMAIL_SERVER_URL makes registration refuse rather than silently + # accept unverified accounts; this is how you opt into the weaker mode. + ALLOW_UNVERIFIED_REGISTRATION: ${ALLOW_UNVERIFIED_REGISTRATION:-} LOAD_HOMEBREW_URL: ${LOAD_HOMEBREW_URL:-} depends_on: datomic: diff --git a/docs/DOCKER.md b/docs/DOCKER.md index ca988d12a..ca1c9bd64 100644 --- a/docs/DOCKER.md +++ b/docs/DOCKER.md @@ -208,9 +208,10 @@ These are the variables you'll actually touch. Full reference in | `DATOMIC_URL` | Yes | `datomic:dev://datomic:4334/orcpub` | Database connection URI. No `?password=` — the app adds it from `DATOMIC_PASSWORD`. | | `PORT` | No | `8890` | App server port. Nginx and healthcheck adapt automatically. | | `ALT_HOST` | No | `127.0.0.1` | Transactor peer fallback host. Change to `datomic` for Swarm. | -| `EMAIL_SERVER_URL` | No | *(empty)* | SMTP server. Leave empty to disable email (registration still works, just no verification emails). | +| `EMAIL_SERVER_URL` | No | *(empty)* | Your SMTP server. Leave it empty and nobody can sign up: the site can't send the confirmation email, so it turns registration off rather than letting people in unchecked. To run without email, see the next setting. | +| `ALLOW_UNVERIFIED_REGISTRATION` | No | `false` | Set this to `true`, and leave `EMAIL_SERVER_URL` empty, to let people sign up without confirming their email. Their accounts work right away. Only do this on a private site — anyone can sign up using an address that isn't theirs. It does nothing if you have SMTP set up. | | `CSP_POLICY` | No | `strict` | Content Security Policy: `strict`, `permissive`, or `none`. | -| `DEV_MODE` | No | *(empty)* | Set to `true` for CSP Report-Only mode (allows Figwheel hot-reload). | +| `DEV_MODE` | No | *(empty)* | Set to `true` to send no CSP header at all, which is what allows Figwheel hot-reload. Not a Report-Only mode — that does not exist. | | `LOAD_HOMEBREW_URL` | No | *(empty)* | URL to fetch `.orcbrew` plugins on first page load. | `run` generates `DATOMIC_PASSWORD`, `ADMIN_PASSWORD`, and diff --git a/docs/ENVIRONMENT.md b/docs/ENVIRONMENT.md index 99ebff0eb..293d37cf2 100644 --- a/docs/ENVIRONMENT.md +++ b/docs/ENVIRONMENT.md @@ -47,10 +47,10 @@ All configuration is managed via a `.env` file at the repository root. Copy `.en | Variable | Default | Description | |----------|---------|-------------| | `CSP_POLICY` | `strict` | Content Security Policy mode: `strict`, `permissive`, or `none` | -| `DEV_MODE` | `"true"` (in :dev profile) | Enables dev-mode CSP (Report-Only instead of enforcing). Must be the string `"true"` (case-insensitive) -- any other value (including `"1"`, `"yes"`, or empty) is treated as false. | +| `DEV_MODE` | `"true"` (in :dev profile) | When true, **no CSP header is sent at all** — that is what lets Figwheel's `ws://localhost:3449` through. Must be the string `"true"` (case-insensitive); any other value, including `"1"`, `"yes"` or empty, is false. | CSP modes: -- **strict** — nonce-based CSP with `strict-dynamic`. Dev mode uses `Report-Only` header (logs violations but doesn't block). Prod uses enforcing header. +- **strict** — nonce-based CSP with `strict-dynamic`, always as an enforcing `Content-Security-Policy` header. **There is no Report-Only mode**; no code has ever emitted `Content-Security-Policy-Report-Only`. Dev mode does not soften the policy, it skips it. - **permissive** — allows `unsafe-inline` and `unsafe-eval`. Legacy fallback. - **none** — disables CSP entirely. Not recommended for production. @@ -69,10 +69,11 @@ See `docker/transactor.properties.template` for the full transactor configuratio | Variable | Default | Description | |----------|---------|-------------| -| `EMAIL_SERVER_URL` | — | SMTP server hostname. Leave empty to disable email. | +| `EMAIL_SERVER_URL` | — | Your SMTP server. If it's empty, nobody can sign up — the site can't send a confirmation email, so it turns registration off instead of letting people in unchecked. | | `EMAIL_ACCESS_KEY` | — | SMTP username | | `EMAIL_SECRET_KEY` | — | SMTP password | | `EMAIL_SERVER_PORT` | `587` | SMTP port | +| `ALLOW_UNVERIFIED_REGISTRATION` | `false` | Set to `true`, with `EMAIL_SERVER_URL` empty, to let people sign up without confirming their email. For private sites only. Does nothing if SMTP is set up. You have to ask for this on purpose, so that losing your SMTP settings by accident can't quietly stop the site checking addresses. | | `EMAIL_FROM_ADDRESS` | `no-reply@dungeonmastersvault.com` | Sender email address | | `EMAIL_ERRORS_TO` | — | Error notification recipient | | `EMAIL_SSL` | `FALSE` | Enable SSL for SMTP | diff --git a/docs/docker-user-management.md b/docs/docker-user-management.md index de4c33512..a47acc56d 100644 --- a/docs/docker-user-management.md +++ b/docs/docker-user-management.md @@ -88,7 +88,8 @@ The setup script creates a `.env` file used by `docker-compose.yaml`. You can al | `ADMIN_PASSWORD` | Datomic admin interface password | generated | | `DATOMIC_PASSWORD` | Datomic application password | generated | | `SIGNATURE` | JWT signing secret (20+ chars) | generated | -| `EMAIL_SERVER_URL` | SMTP server (leave empty to skip email) | empty | +| `EMAIL_SERVER_URL` | SMTP server. Leave it empty and sign-ups are turned off, unless you also set the next one | empty | +| `ALLOW_UNVERIFIED_REGISTRATION` | Allow sign-ups without an email confirmation. Private sites only | `false` | | `EMAIL_ACCESS_KEY` | SMTP username | empty | | `EMAIL_SECRET_KEY` | SMTP password | empty | | `EMAIL_SERVER_PORT` | SMTP port | `587` | diff --git a/docs/email-system.md b/docs/email-system.md index a6b39384d..55664f66a 100644 --- a/docs/email-system.md +++ b/docs/email-system.md @@ -55,6 +55,16 @@ User attributes related to email and verification (`src/clj/orcpub/db/schema.clj **Re-verify:** `GET /re-verify?email=...` (`routes/re-verify`) re-sends the verification email for unverified accounts. +**No SMTP configured:** `do-verification` checks `email/configured?` first. With no SMTP host and +`ALLOW_UNVERIFIED_REGISTRATION=true`, the account is transacted `verified? true`, no mail is sent, +and the response carries `{:verified? true}` so the client shows "you can log in" rather than +"check your email". With no SMTP host and **no** opt-in, registration is refused with +`:email-not-configured` — fail closed, so a lost SMTP value cannot quietly become open +registration. Startup warns in all three abnormal combinations; a correct config is silent. + +**Send failure:** the account is rolled back. `register` retracts the new entity; `re-verify` +retracts only the attributes that attempt set, never the existing user. + **Login gate:** Unverified users cannot log in. If the verification has expired, the login error tells them to re-register. **Files:** `routes.clj:register`, `routes.clj:do-verification`, `routes.clj:verify`, `email.clj:send-verification-email` diff --git a/docs/migration/pedestal-0.7.md b/docs/migration/pedestal-0.7.md index 22c183413..f2062d827 100644 --- a/docs/migration/pedestal-0.7.md +++ b/docs/migration/pedestal-0.7.md @@ -51,7 +51,7 @@ In CSP Level 3 browsers (all modern browsers), `strict-dynamic` causes the brows 1. `nonce-interceptor` (in `pedestal.clj`) generates a 128-bit nonce per request 2. The nonce is stored in `[:request :csp-nonce]` for templates to read 3. On `:leave`, the interceptor sets the `Content-Security-Policy` header with the nonce -4. **Dev mode**: The nonce interceptor is a no-op — no nonce is generated, no CSP header is added. Pedestal 0.7's built-in `secure-headers` still applies its own defaults, but the custom nonce header is skipped entirely. This avoids flooding the browser console with Report-Only violations from Figwheel's inline scripts. +4. **Dev mode**: The nonce interceptor is a no-op — no nonce is generated, no CSP header is added. Pedestal 0.7's built-in `secure-headers` still applies its own defaults, but the custom nonce header is skipped entirely. This is what lets Figwheel's inline scripts and its `ws://localhost:3449` connection through: the policy is not softened, it is simply not sent. (Earlier revisions of this file called that a "Report-Only" mode. No such mode exists here — nothing has ever emitted `Content-Security-Policy-Report-Only`.) 5. **Prod mode**: Enforcing `Content-Security-Policy` with per-request nonces **Configuration** via `CSP_POLICY` env var (see `.env.example`): diff --git a/project.clj b/project.clj index f60454c33..ca59d47b6 100644 --- a/project.clj +++ b/project.clj @@ -73,12 +73,17 @@ ;; datomock fork with Datomic Pro 1.0.6527+ compatibility (new transact signature) ;; Original vvvvalvalval/datomock 0.2.0 causes AbstractMethodError with Datomic Pro [org.clojars.favila/datomock "0.2.2-favila1"] - ;; Datomic Pro: Free under Apache 2.0, supports Java 11/17/21, actively maintained. + ;; The peer library, free under Apache 2.0, Java 11/17/21. ;; Exclude slf4j-nop to avoid duplicate SLF4J binding warnings. - ;; Installed to lib/com/datomic/datomic-pro/1.0.7482/ during Docker build/postCreateCommand - ;; Uses existing file:lib repository pattern (same as pdfbox) + ;; Resolves from MAVEN CENTRAL -- not from file:lib, and no local + ;; install is needed to build or test. The commented-out + ;; com.datomic/datomic-pro coordinate that used to sit here did need + ;; one, and its comment kept implying this dependency still does. + ;; lib/com/datomic/datomic-pro// is still populated, but by + ;; .devcontainer/post-create.sh and docker/Dockerfile, and for the + ;; TRANSACTOR BINARY that scripts/common.sh:257 and start.sh run -- + ;; not for this jar. ;; Latest version: https://docs.datomic.com/releases-pro.html - ;[com.datomic/datomic-pro "1.0.7482" :exclusions [org.slf4j/slf4j-nop]] [com.datomic/peer "1.0.7482" :exclusions [org.slf4j/slf4j-nop]] ;; cuerdas 026.415: Latest release on Clojars... does not match GH release versioning. [funcool/cuerdas "2026.415"] @@ -272,7 +277,6 @@ :optimizations :none}}]} :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}} ;; NOTE: :prod was for React Native builds (legacy, may be unused) - ;; datomic-pro dependency removed - peer is already in main deps :prod {:cljsbuild {:builds [{:id "main" :source-paths ["src/cljs" "native/cljs" "src/cljc" "env/prod"] :compiler {:output-to "main.js" diff --git a/scripts/common.sh b/scripts/common.sh index c59da0336..8bb8ea6ef 100755 --- a/scripts/common.sh +++ b/scripts/common.sh @@ -31,6 +31,241 @@ if [[ -f "$REPO_ROOT/.env" ]]; then set +a fi +# Configuration reporting and the DEV_MODE decision. +# +# Deliberately NOT printed at the top of every run. Output at the start of a +# script scrolls past before the REPL takes the terminal, and nobody reads it. +# Attention exists in two places only: at a prompt, and in a command whose +# output IS the product. So: +# +# print_env_config -> called from run_checks (--check), where it is the point +# offer_env_file -> a prompt, which is a genuine pause +# confirm_dev_mode -> a decision, raised at figwheel start where it bites + +# The settings that fail silently: ports (a busy one used to read as free on +# Windows) and CSP/DEV_MODE (blocks Figwheel's socket with no visible cause). +print_env_config() { + if [[ -f "$REPO_ROOT/.env" ]]; then + echo -e "Config: ${GREEN}.env${NC} (edit it to change any of the below)" + else + echo -e "Config: ${YELLOW}built-in defaults${NC} (no .env — see .env.example)" + fi + echo " ports server=$SERVER_PORT datomic=$DATOMIC_PORT figwheel=$FIGWHEEL_PORT nrepl=$NREPL_PORT" + + local policy dev + policy="$(effective_csp_policy)" + dev="${DEV_MODE:-}" + if dev_mode_blocks_figwheel; then + echo -e " csp ${YELLOW}$policy, ENFORCING${NC} (DEV_MODE=$dev) — Figwheel hot reload blocked" + else + echo " csp policy=$policy DEV_MODE=$dev" + fi +} + +# The policy token as the server resolves it: config/get-csp-policy is now +# (env/value :csp-policy "strict"), and orcpub.env/value treats blank as absent. +# So ${CSP_POLICY:-strict} is correct again -- unset and empty both mean strict. +# +# This briefly used ${CSP_POLICY+x} to distinguish them, because the server used +# to resolve an empty CSP_POLICY to "" and fall through to the static permissive +# policy. That was a faithful mirror of a server bug; the server was the thing to +# fix, and the mirror got simpler when it was. +# +# LC_ALL=C on the tr is load-bearing, and is this branch's own subject matter: +# tr '[:upper:]' '[:lower:]' folds using the shell's locale, so on a Turkish +# machine "STRICT" becomes "strıct" and matches nothing. config/get-csp-policy +# avoids the same trap with Locale/ROOT. +_csp_policy_token() { + printf '%s' "${CSP_POLICY:-strict}" | LC_ALL=C tr 'A-Z' 'a-z' +} + +# The policy the SERVER will actually USE. An unrecognised value is not an error +# there: get-secure-headers-config cond-falls through to permissive-csp-settings, +# so report what it BECOMES, not what was typed. +effective_csp_policy() { + local p + p="$(_csp_policy_token)" + case "$p" in + strict|permissive|none) printf '%s' "$p" ;; + *) printf 'permissive (fallback from "%s")' "${CSP_POLICY-}" ;; + esac +} + +# True when the server will send a CSP whose connect-src omits the Figwheel +# websocket, so hot reload fails silently. +dev_mode_blocks_figwheel() { + local policy + policy="$(_csp_policy_token)" + + # Mirror config/get-secure-headers-config, which is a three-way cond and not + # a two-way one: + # + # none -> :content-security-policy-settings nil, no CSP at all + # strict -> settings nil; the NONCE INTERCEPTOR sets an enforcing + # header, but only when dev-mode? is false. The one policy + # DEV_MODE affects. + # ANY OTHER -> permissive-csp-settings, applied STATICALLY by Pedestal. + # That includes "permissive" and every unrecognised value. + # It has default-src 'self' and no connect-src, so the + # Figwheel websocket is blocked -- and DEV_MODE cannot + # change it, because the nonce interceptor is inert here. + # + # An earlier revision tested `strict|permissive` and then applied the + # DEV_MODE logic to both, so CSP_POLICY=permissive with DEV_MODE=true was + # reported as fine while the server blocked the socket. + case "$policy" in + none) return 1 ;; + strict) ;; + *) return 0 ;; + esac + + # Strict only, from here. See the measured table in the commit that added + # this: unset means the :dev profile supplies "true"; an explicit empty + # string is a value and overrides it; only the literal "true" disables CSP. + [ -z "${DEV_MODE+x}" ] && return 1 + case "$(printf '%s' "$DEV_MODE" | LC_ALL=C tr 'A-Z' 'a-z')" in + true) return 1 ;; + *) return 0 ;; + esac +} + +# Generate a random secret. Hex only, so it is safe to substitute into a file +# without quoting concerns. Empty string if no source is available. +random_secret() { + if command -v openssl >/dev/null 2>&1; then + openssl rand -hex 24 2>/dev/null && return 0 + fi + if [[ -r /dev/urandom ]] && command -v od >/dev/null 2>&1; then + od -An -tx1 -N24 /dev/urandom 2>/dev/null | tr -d ' \n' && return 0 + fi + printf '' +} + +# Replace KEY=... in a file, portably. sed -i differs between GNU and BSD, so +# write to a temp file and move it into place instead. +set_env_value() { + local file="$1" key="$2" value="$3" tmp + tmp="$(mktemp)" || return 1 + awk -v k="$key" -v v="$value" ' + $0 ~ "^" k "=" { print k "=" v; next } + { print } + ' "$file" > "$tmp" && mv "$tmp" "$file" +} + +# First run: a short guided setup. A prompt is one of the two moments an +# operator is actually reading, so this is where configuration is worth +# raising -- and while they are here, the three change-me placeholders are +# worth resolving, because each is a credential that otherwise ships as a +# known string. +# +# Only when there is nothing to lose (no .env present) and someone is at the +# keyboard. A non-interactive run is told what to do and never blocked. +offer_env_file() { + local env_file="$REPO_ROOT/.env" example="$REPO_ROOT/.env.example" + [[ -f "$env_file" || ! -f "$example" ]] && return 0 + + if ! is_interactive; then + log_info "No .env — using built-in defaults. To configure: cp .env.example .env" + return 0 + fi + + echo "" + log_warn "No .env found. Defaults will be used: CSP_POLICY=strict, and the" + log_warn "placeholder SIGNATURE / ADMIN_PASSWORD / DATOMIC_PASSWORD from the" + log_warn "template, which are published values and must not face a network." + + local reply="" + read -t 30 -p "Create .env from .env.example now? [y/N] " -n 1 -r reply || { echo; log_info "No answer — continuing on defaults."; return 0; } + echo + [[ "$reply" =~ ^[Yy]$ ]] || { log_info "Skipped. Continuing on defaults."; return 0; } + + cp "$example" "$env_file" || { log_error "Could not write $env_file"; return 0; } + chmod 600 "$env_file" 2>/dev/null || true + + # --- development or production ------------------------------------------- + local mode="" + read -t 30 -p "Set up for [d]evelopment or [p]roduction? [D/p] " -n 1 -r mode || mode="" + echo + if [[ "$mode" =~ ^[Pp]$ ]]; then + set_env_value "$env_file" DEV_MODE false + log_info " DEV_MODE=false — CSP enforcing. Figwheel hot reload will not work." + else + set_env_value "$env_file" DEV_MODE true + log_info " DEV_MODE=true — no CSP header, so Figwheel works." + fi + + # --- the three change-me credentials ------------------------------------- + local gen="" + read -t 30 -p "Generate random values for the change-me passwords/secret? [Y/n] " -n 1 -r gen || gen="" + echo + if [[ "$gen" =~ ^[Nn]$ ]]; then + log_warn " Left as-is. SIGNATURE, ADMIN_PASSWORD and DATOMIC_PASSWORD are" + log_warn " published placeholders — change them before exposing this server." + else + local key secret failed=0 + for key in SIGNATURE ADMIN_PASSWORD DATOMIC_PASSWORD; do + secret="$(random_secret)" + if [[ -n "$secret" ]]; then + set_env_value "$env_file" "$key" "$secret" + else + failed=1 + fi + done + if [[ $failed -eq 0 ]]; then + # Deliberately not echoed. They are in the file; printing them puts + # them in scrollback and shell history exports. + log_info " SIGNATURE, ADMIN_PASSWORD, DATOMIC_PASSWORD set to random values." + else + log_warn " No random source (openssl / /dev/urandom) — placeholders left in place." + fi + fi + + log_info "Wrote $env_file (mode 600). Review it, then re-run to start." + # Returning 10 means "written, caller should stop". Continuing is not an + # option: .env was sourced near the top of this file, before it existed, and + # every default and derived path was computed from what was loaded then. The + # DEV_MODE just chosen and the credentials just generated are not in this + # shell and cannot be, so carrying on would launch the server on exactly the + # configuration the user was asked about and answered. + return 10 +} + +# Raised where it actually bites. Starting Figwheel with an enforcing CSP gives +# a dev loop that looks fine and silently never reloads, so this is a decision, +# not a line of output to scroll past. +confirm_dev_mode() { + dev_mode_blocks_figwheel || return 0 + + local policy + policy="$(effective_csp_policy)" + log_warn "CSP policy is $policy and ENFORCING (DEV_MODE=${DEV_MODE:-})." + log_warn "ws://localhost:$FIGWHEEL_PORT is not in connect-src, so hot reload" + log_warn "will silently not work." + # The remedy differs by policy, and the old text gave the strict one for all + # of them. Under permissive (and any unrecognised value, which becomes + # permissive) the policy is applied statically by Pedestal and DEV_MODE has + # no effect at all, so "set DEV_MODE=true" is advice that cannot work. + case "$policy" in + strict) log_warn "Set DEV_MODE=true in .env to develop." ;; + *) log_warn "DEV_MODE does not affect this policy -- it is applied" + log_warn "statically. Use CSP_POLICY=strict with DEV_MODE=true," + log_warn "or CSP_POLICY=none." ;; + esac + + is_interactive || { log_warn "Continuing anyway (non-interactive)."; return 0; } + + local reply="" + if read -t 30 -p "Start Figwheel anyway? [y/N] " -n 1 -r reply; then + echo + [[ "$reply" =~ ^[Yy]$ ]] && return 0 + log_info "Aborted. Set DEV_MODE=true in .env, then re-run." + return 1 + fi + echo + log_info "No answer — not starting Figwheel." + return 1 +} + # Defaults (used if not set in .env) DATOMIC_VERSION="${DATOMIC_VERSION:-1.0.7482}" DATOMIC_TYPE="${DATOMIC_TYPE:-pro}" @@ -39,7 +274,13 @@ LOG_DIR="${LOG_DIR:-$REPO_ROOT/logs}" # Port configuration DATOMIC_PORT="${DATOMIC_PORT:-4334}" -SERVER_PORT="${SERVER_PORT:-8890}" +# PORT is what BOTH service maps now read (orcpub.system/configured-port) and +# what .env.example documents, so the scripts follow it too. They have to agree: +# when the dev map pinned a literal 8890 and this read PORT, every port check, +# explain_bind_failure and config report described a port nothing was listening +# on. SERVER_PORT still overrides, for moving the scripts without moving the +# server. +SERVER_PORT="${SERVER_PORT:-${PORT:-8890}}" NREPL_PORT="${NREPL_PORT:-7888}" FIGWHEEL_PORT="${FIGWHEEL_PORT:-3449}" GARDEN_PORT="${GARDEN_PORT:-3000}" @@ -140,9 +381,40 @@ log_error() { # ----------------------------------------------------------------------------- # Check if a port is in use (returns 0 if in use, 1 if free) +# True under Git Bash / MSYS2 / Cygwin, where `netstat` is Windows' netstat.exe. +is_windows() { + case "$(uname -s 2>/dev/null)" in + MINGW*|MSYS*|CYGWIN*) return 0 ;; + *) return 1 ;; + esac +} + +# Windows netstat.exe has no -l flag, so the GNU-style `netstat -tln` below +# exits with "Invalid argument" and prints nothing to stdout. With stderr +# discarded that reads as "no match" — i.e. every port looks free, the +# pre-flight check never warns, and the JVM is the first thing to discover the +# conflict (BindException: Address already in use). Ask Windows its own way. port_in_use() { local port="$1" - if command -v lsof >/dev/null 2>&1; then + if is_windows; then + # Match on the LOCAL ADDRESS column, not the state word: netstat.exe + # prints "LISTENING" where the docs say "LISTEN", and a non-English + # Windows translates it outright. Column 2 is the local address on + # every row; the last column is the PID. + # A bound port is one with a LISTENING socket. Matching the address + # column alone also matches TIME_WAIT and ESTABLISHED rows, so a + # connection that closed seconds ago reads as "in use" and start.sh + # refuses to start. Identify listening rows by the WILDCARD FOREIGN + # ADDRESS rather than the state word -- the state word is localised + # (LISTENING/LISTEN/translated), the foreign address is not. + # $1 == "TCP" is load-bearing. A UDP row is printed with four columns + # and a literal "*:*" foreign address, so it satisfies the wildcard test + # above; without the protocol check a UDP socket on this port makes a + # free TCP port read as busy and start.sh refuses to start. + [ -n "$(netstat -ano 2>/dev/null \ + | awk -v p="[:.]${port}\$" \ + '$1 == "TCP" && $2 ~ p && $3 ~ /^(0\.0\.0\.0:0|\[::\]:0|\*:\*)$/ {print; exit}')" ] + elif command -v lsof >/dev/null 2>&1; then lsof -i ":${port}" >/dev/null 2>&1 elif command -v ss >/dev/null 2>&1; then ss -tln 2>/dev/null | grep -q ":${port}\b" @@ -165,7 +437,7 @@ wait_for_port() { return 0 fi sleep 1 - ((elapsed++)) + elapsed=$((elapsed + 1)) done return 1 } @@ -189,7 +461,7 @@ wait_for_port_or_die() { return 0 fi sleep 1 - ((elapsed++)) + elapsed=$((elapsed + 1)) done log_error "Timeout waiting for port $port (process $pid still running)" return 1 @@ -206,7 +478,7 @@ wait_for_port_free() { return 0 fi sleep 1 - ((elapsed++)) + elapsed=$((elapsed + 1)) done return 1 } @@ -216,6 +488,20 @@ find_pids_by_port() { local port="$1" local pids="" + if is_windows; then + # Last column of a LISTENING row is the owning PID. + # $1 == "TCP" for the same reason as port_in_use, and it matters more + # here: stop.sh feeds these PIDs to kill, so a UDP row passing the + # wildcard test would terminate an unrelated process that merely shares + # the port number. + pids=$(netstat -ano 2>/dev/null \ + | awk -v p="[:.]${port}\$" \ + '$1 == "TCP" && $2 ~ p && $3 ~ /^(0\.0\.0\.0:0|\[::\]:0|\*:\*)$/ && $NF ~ /^[0-9]+$/ {print $NF}' \ + | sort -u || true) + echo "$pids" | tr '\n' ' ' | xargs + return + fi + if command -v lsof >/dev/null 2>&1; then pids=$(lsof -t -i ":${port}" 2>/dev/null || true) elif command -v ss >/dev/null 2>&1; then @@ -271,14 +557,27 @@ get_uptime() { # ----------------------------------------------------------------------------- check_java() { - local java_version - java_version=$(java -version 2>&1 | head -1 | sed -E 's/.*"([0-9]+).*/\1/') - - if [[ -z "$java_version" ]]; then + local raw java_version + if ! raw="$(java -version 2>&1)"; then log_error "Java not found. Please install Java $JAVA_MIN_VERSION or higher." return 1 fi + # Find the version line wherever it is, rather than assuming line 1. + # JAVA_TOOL_OPTIONS and _JAVA_OPTIONS make the JVM print a "Picked up ..." + # preamble first, which is common behind a proxy and in CI images. + java_version="$(printf '%s\n' "$raw" | sed -nE 's/.*version "([0-9]+).*/\1/p' | head -n1)" + + # Guard the comparison below. [[ str -lt n ]] evaluates str as ARITHMETIC, + # so a non-numeric value is read as a variable name -- and under `set -u` + # an unset name is a FATAL error, not a false comparison. That killed this + # script outright, and silently, because callers use `check_java 2>/dev/null`. + if [[ ! "$java_version" =~ ^[0-9]+$ ]]; then + log_error "Could not read a Java version. First line of 'java -version':" + log_error " $(printf '%s\n' "$raw" | head -n1)" + return 1 + fi + if [[ "$java_version" -lt "$JAVA_MIN_VERSION" ]]; then log_error "Java $JAVA_MIN_VERSION+ required (found Java $java_version)." log_info "Use the devcontainer or install a compatible JDK." @@ -334,23 +633,121 @@ check_datomic_installed() { # Process Management # ----------------------------------------------------------------------------- +# Signal a process. On Windows the PIDs we discover come from netstat -ano and +# are native Windows PIDs, which Git Bash's `kill` cannot reliably signal — so +# stop.sh would report success while the process kept holding the port. The +# leading `//` stops MSYS rewriting /PID into a path. +signal_pid() { + local pid="$1" sig="${2:-TERM}" + if is_windows; then + # A pid here can be either kind: find_service_pids checks the PID FILE + # first, which holds an MSYS pid (written from $! by start.sh), and only + # falls back to netstat -ano, which yields a native Windows pid. `kill` + # handles the first, taskkill the second, and neither handles both — so + # try kill, then taskkill. + kill "-$sig" "$pid" 2>/dev/null && return 0 + if [[ "$sig" == "KILL" ]]; then + taskkill //PID "$pid" //F >/dev/null 2>&1 + else + taskkill //PID "$pid" >/dev/null 2>&1 + fi + else + kill "-$sig" "$pid" 2>/dev/null + fi +} + +# Is this PID still alive? +pid_alive() { + local pid="$1" + if is_windows; then + # Same two-kinds-of-pid problem as signal_pid: ask both. + kill -0 "$pid" 2>/dev/null && return 0 + tasklist //FI "PID eq $pid" 2>/dev/null | grep -qE "[[:space:]]${pid}[[:space:]]" + else + kill -0 "$pid" 2>/dev/null + fi +} + +# When the JVM dies with "Address already in use", say why in terms the user can +# act on. This runs AFTER lein exits, which is the only moment it can: the REPL +# holds the terminal while it lives, so nothing downstream runs until it stops. +# The pre-flight check cannot cover this case — a port RESERVED by Windows reads +# as free to every listing tool, right up until bind fails. +explain_bind_failure() { + local port="$1" + local pids + pids="$(find_pids_by_port "$port")" + if [[ -n "${pids// /}" ]]; then + echo "" + log_error "The server could not bind port $port." + log_error "Something is already listening on it (PID: $pids)." + if is_windows; then + log_error " Stop it with: taskkill /PID ${pids%% *} /F" + else + log_error " Stop it with: kill ${pids%% *}" + fi + return + fi + + if is_windows && command -v netsh >/dev/null 2>&1; then + local ranges reserved="" + ranges="$(netsh interface ipv4 show excludedportrange protocol=tcp 2>/dev/null | tr -d '\r')" + while read -r lo hi _rest; do + [[ "$lo" =~ ^[0-9]+$ ]] || continue + [[ "$hi" =~ ^[0-9]+$ ]] || continue + if (( port >= lo && port <= hi )); then reserved="$lo-$hi"; fi + done <<< "$ranges" + if [[ -n "$reserved" ]]; then + echo "" + log_error "The server could not bind port $port." + log_error "Nothing is listening, but Windows has RESERVED $port (range $reserved)." + log_error " Hyper-V/WSL2/Docker take these ranges. In an admin terminal:" + log_error " net stop winnat && net start winnat" + return + fi + fi + + # Nothing holds the port and it is not reserved, so there is no evidence + # this was a bind failure at all — lein exits non-zero for ordinary reasons + # too, Ctrl+C among them. Saying "could not bind" here would be crying wolf + # after a normal shutdown, so say nothing. + return 0 +} + +# Which REPL mode should the server start in? +# +# Git Bash reports stdin as a terminal, so the old `[[ -t 0 ]]` test chose the +# interactive REPL there — but its terminal is not a Windows console. The REPL +# prints its prompt, exits immediately, and takes the already-bound server down +# with it ("Subprocess failed (exit code: 1)" / "Bye for now!"). Headless is the +# same server without that passenger, so Windows always gets headless. +repl_mode() { + if is_windows; then + echo headless + elif [[ -t 0 ]]; then + echo interactive + else + echo headless + fi +} + # Graceful shutdown with SIGKILL fallback kill_gracefully() { local pid="$1" local wait_secs="${2:-$KILL_WAIT}" # Try SIGTERM first - kill -TERM "$pid" 2>/dev/null || return 0 + signal_pid "$pid" TERM || return 0 # Wait for process to exit for ((i=0; i/dev/null || return 0 + pid_alive "$pid" || return 0 sleep 1 done # Process still running - escalate to SIGKILL log_warn "Process $pid didn't stop gracefully, sending SIGKILL" - kill -KILL "$pid" 2>/dev/null || true + signal_pid "$pid" KILL || true } # Clean up stale PID files diff --git a/scripts/start.sh b/scripts/start.sh index 8ddb5f912..362dc2122 100755 --- a/scripts/start.sh +++ b/scripts/start.sh @@ -174,7 +174,7 @@ run_checks() { echo -e "${GREEN}OK${NC}" else echo -e "${RED}FAILED${NC}" - ((failed++)) + failed=$((failed + 1)) fi echo -n "Leiningen: " @@ -182,7 +182,7 @@ run_checks() { echo -e "${GREEN}OK${NC}" else echo -e "${RED}FAILED${NC}" - ((failed++)) + failed=$((failed + 1)) fi # Target-specific checks @@ -193,7 +193,7 @@ run_checks() { echo -e "${GREEN}OK${NC}" else echo -e "${RED}FAILED${NC}" - ((failed++)) + failed=$((failed + 1)) fi echo -n "Datomic config: " @@ -209,7 +209,7 @@ run_checks() { fi else echo -e "${RED}FAILED${NC} (no config or template)" - ((failed++)) + failed=$((failed + 1)) fi echo -n "Datomic port ($DATOMIC_PORT): " @@ -265,6 +265,9 @@ run_checks() { ;; esac + echo "" + print_env_config + echo "" if [[ $failed -gt 0 ]]; then log_error "$failed prerequisite check(s) failed" @@ -406,13 +409,19 @@ start_server() { cd "$REPO_ROOT" # Use headless mode if not running interactively (background/nohup) - if [[ -t 0 ]]; then + local rc=0 + if [[ "$(repl_mode)" == "interactive" ]]; then log_info "Starting REPL with server (profile: +dev,+start-server)..." - lein with-profile +dev,+start-server repl + lein with-profile +dev,+start-server repl || rc=$? else log_info "Starting headless server (profile: +dev,+start-server)..." - lein with-profile +dev,+start-server repl :headless + is_windows && log_info "Headless on Windows: the Git Bash REPL exits on start and stops the server." + lein with-profile +dev,+start-server repl :headless || rc=$? fi + # The REPL held the terminal until now; this is the first chance to explain + # a bind failure, and the only place the reserved-port case is visible. + [[ $rc -ne 0 ]] && explain_bind_failure "$SERVER_PORT" + return $rc } start_figwheel() { @@ -432,6 +441,8 @@ start_figwheel() { # Clean up stale PID file cleanup_stale_pid "figwheel" + confirm_dev_mode || exit $EXIT_SUCCESS + # ── Remote dev environment detection ────────────────────────────── # Figwheel's default connect URL (ws://localhost:PORT) only works when # the browser is on the same machine. In remote environments (Codespaces, @@ -519,7 +530,7 @@ start_garden() { show_startup_failure "garden" "$LOG_DIR/garden.log" "" exit $EXIT_RUNTIME fi - ((checks++)) + checks=$((checks + 1)) done log_info "Garden is running" } @@ -628,7 +639,15 @@ start_all() { log_info "Starting REPL with server (profile: +dev,+start-server)..." log_info "Note: Ctrl+C will stop both server and Datomic" cd "$REPO_ROOT" - lein with-profile +dev,+start-server repl + local rc=0 + if [[ "$(repl_mode)" == "interactive" ]]; then + lein with-profile +dev,+start-server repl || rc=$? + else + is_windows && log_info "Headless on Windows: the Git Bash REPL exits on start and stops the server." + lein with-profile +dev,+start-server repl :headless || rc=$? + fi + [[ $rc -ne 0 ]] && explain_bind_failure "$SERVER_PORT" + return $rc } # ----------------------------------------------------------------------------- @@ -767,6 +786,24 @@ main() { exit $? fi + # First-run .env offer. A prompt is read; a banner is not -- so this is the + # one interactive thing that happens before startup. + # + # It goes HERE, below every non-startup branch, not above them: `help`, + # `--install` and `--check` are not requests to start a server, and none of + # them should stop to ask whether to write a file. (`--help` already exits + # during argument parsing.) It used to sit above all three. + # + # Return 10 means the file was written. Stop there rather than start: .env + # was sourced before it existed, so the answers just given are not in this + # shell and the server would launch on the configuration the user was asked + # about and answered. + offer_env_file || { + rc=$? + [[ $rc -eq 10 ]] && exit $EXIT_SUCCESS + exit $rc + } + # Check prerequisites for runtime targets check_java || exit $EXIT_PREREQ check_lein || exit $EXIT_PREREQ diff --git a/scripts/stop.sh b/scripts/stop.sh index c5064ea4d..c8ddae26a 100755 --- a/scripts/stop.sh +++ b/scripts/stop.sh @@ -40,7 +40,7 @@ show_status() { # Quiet mode: just exit codes local running=0 for port in "$DATOMIC_PORT" "$SERVER_PORT" "$NREPL_PORT"; do - port_in_use "$port" && ((running++)) + port_in_use "$port" && running=$((running + 1)) done echo "$running" return @@ -133,7 +133,7 @@ kill_pids() { [[ "$quiet" != "true" ]] && log_info "Sending SIGTERM to PIDs: $pids" for pid in $pids; do - kill -TERM "$pid" 2>/dev/null || true + signal_pid "$pid" TERM || true done sleep "$wait_time" @@ -141,7 +141,7 @@ kill_pids() { # Check for survivors local remaining="" for pid in $pids; do - kill -0 "$pid" 2>/dev/null && remaining="$remaining $pid" + pid_alive "$pid" && remaining="$remaining $pid" done remaining=$(echo "$remaining" | xargs) @@ -149,7 +149,7 @@ kill_pids() { if [[ "$use_force" == "true" ]]; then [[ "$quiet" != "true" ]] && log_warn "Processes still running, sending SIGKILL: $remaining" for pid in $remaining; do - kill -KILL "$pid" 2>/dev/null || true + signal_pid "$pid" KILL || true done sleep 1 else diff --git a/src/clj/orcpub/config.clj b/src/clj/orcpub/config.clj index f7cbc1064..b62e6e007 100644 --- a/src/clj/orcpub/config.clj +++ b/src/clj/orcpub/config.clj @@ -1,7 +1,8 @@ (ns orcpub.config - (:require [environ.core :refer [env]] + (:require [orcpub.env :as env] [clojure.string :as str] - [clojure.java.io :as io])) + [clojure.java.io :as io]) + (:import [java.util Locale])) (def default-datomic-uri "datomic:dev://localhost:4334/orcpub") @@ -14,23 +15,20 @@ (not-empty (str/trim (slurp f)))))) (defn datomic-env - "Return the raw DATOMIC_URL environment value or nil if unset." [] - (or (env :datomic-url) - (some-> (System/getenv "DATOMIC_URL") not-empty))) + "Return the raw DATOMIC_URL environment value or nil if unset or blank." [] + (env/value :datomic-url)) (defn datomic-password "Return DATOMIC_PASSWORD from Docker secret, env var, or nil. Resolution order: /run/secrets/datomic_password > DATOMIC_PASSWORD env var." [] (or (read-secret "datomic_password") - (env :datomic-password) - (some-> (System/getenv "DATOMIC_PASSWORD") not-empty))) + (env/value :datomic-password))) (defn signature "Return SIGNATURE from Docker secret, env var, or nil. Resolution order: /run/secrets/signature > SIGNATURE env var." [] (or (read-secret "signature") - (env :signature) - (some-> (System/getenv "SIGNATURE") not-empty))) + (env/value :signature))) (defn get-datomic-uri "Return the Datomic URI from the environment or the default. @@ -68,28 +66,44 @@ (defn get-csp-policy "Return the CSP policy from CSP_POLICY env var. Defaults to 'strict'." [] - (let [policy (or (env :csp-policy) - (System/getenv "CSP_POLICY") - "strict")] - (str/lower-case policy))) + ;; env-value, so an EMPTY CSP_POLICY means unset and therefore "strict". + ;; It used to mean "": not strict, not none, so get-secure-headers-config + ;; fell through to the static permissive policy. An empty setting silently + ;; selecting a DIFFERENT and less strict policy than the documented default + ;; is the opposite of what the blank was meant to express. + (let [policy (env/value :csp-policy "strict")] + ;; Locale/ROOT, not str/lower-case: this is an ASCII config token, not + ;; prose. str/lower-case folds using the default locale, so on a Turkish + ;; machine "STRICT" becomes "strıct" (dotless i), misses every comparison + ;; below, and silently falls through to the permissive policy. + (.toLowerCase ^String policy Locale/ROOT))) (defn dev-mode? "Returns true when running in dev mode (DEV_MODE env var is 'true'). Env vars are strings — (boolean \"false\") is true in Clojure, so we must compare against the string \"true\" explicitly." [] - (= "true" (str/lower-case (or (env :dev-mode) "")))) + ;; equalsIgnoreCase compares per character rather than by locale casing + ;; rules, so it is immune to the Turkish-I problem described above. Note the + ;; receiver order: the literal is first so a nil env var returns false + ;; instead of throwing. + (env/flag? :dev-mode)) (defn strict-csp? "Returns true when CSP_POLICY=strict (regardless of dev mode). - When true, nonce-interceptor generates per-request nonces and adds them - to script tags. The header type depends on mode: - - Dev mode: Content-Security-Policy-Report-Only (violations logged, not blocked) - - Prod mode: Content-Security-Policy (violations blocked) + When true AND dev-mode? is false, nonce-interceptor generates a per-request + nonce and sets an ENFORCING Content-Security-Policy header. - This allows catching CSP issues during development while still allowing - Figwheel's document.write() scripts to execute." + In dev mode it generates no nonce and sets no header at all, so there is no + CSP from this application -- which is what lets Figwheel's scripts and its + websocket work. Note the consequence: DEV_MODE defaults to FALSE, so a + checkout with no .env runs enforcing CSP, and ws://localhost:3449 is absent + from connect-src. Figwheel's hot reload is then blocked with no obvious + cause. .env.example sets DEV_MODE=true for exactly this reason. + + There is no Report-Only mode. Earlier revisions of this docstring described + one; no code has ever emitted Content-Security-Policy-Report-Only." [] (= "strict" (get-csp-policy))) @@ -102,7 +116,7 @@ [] (cond ;; Strict mode - nonce-interceptor handles CSP dynamically - ;; (uses Report-Only in dev, enforcing in prod) + ;; (enforcing when DEV_MODE is not true; no header at all in dev mode) (= "strict" (get-csp-policy)) {:content-security-policy-settings nil} diff --git a/src/clj/orcpub/email.clj b/src/clj/orcpub/email.clj index c6e542e62..abd1c15cc 100644 --- a/src/clj/orcpub/email.clj +++ b/src/clj/orcpub/email.clj @@ -6,7 +6,7 @@ handling to prevent silent failures when the SMTP server is unavailable." (:require [hiccup2.core :as hiccup] [postal.core :as postal] - [environ.core :as environ] + [orcpub.env :as env] [clojure.pprint :as pprint] [clojure.string :as s] [orcpub.route-map :as routes] @@ -75,18 +75,64 @@ [{:type "text/html" :content (str (hiccup/html (email-change-verification-html username verification-url)))}]) +(defn configured? + "True when an SMTP host is set, i.e. when this deployment can send mail. + + .env.example says \"Leave EMAIL_SERVER_URL empty to disable email + functionality\". Nothing implemented that: the variable was read in exactly one + place, as postal's :host, so leaving it blank did not disable email -- it made + every send FAIL. Since registration sends a verification mail, the documented + way to turn email off also turned registration off. This is the predicate that + makes the promise true." + [] + (some? (env/value :email-server-url))) + +(defn unverified-registration-allowed? + "True when this deployment has DELIBERATELY opted out of email verification. + + Keying auto-verification on \"no SMTP configured\" alone fails OPEN: a typo in + the variable name, a value dropped by a deploy, a failed secrets mount, or a + stray space all read as \"no email\", and the site silently stops requiring + verification. Measured -- EMAIL_SERVER_URL as \" \", as empty, and absent + entirely all produced auto-verify, with no signal beyond a println nobody + reads on a running server. + + An attacker cannot flip this: environ.core/env is a static map built once at + namespace load, so no request can change it. The risk is an operator slip + downgrading the site from verified to open registration, which is exactly the + kind of mistake that gets found by someone scanning for it. + + So the weaker mode has to be ASKED FOR. Losing your SMTP config now breaks + registration loudly instead of quietly accepting unverified accounts." + [] + (env/flag? :allow-unverified-registration)) + (defn email-cfg [] (try - {:user (environ/env :email-access-key) - :pass (environ/env :email-secret-key) - :host (environ/env :email-server-url) - :port (Integer/parseInt (or (environ/env :email-server-port) "587")) - :ssl (or (str/to-bool (environ/env :email-ssl)) nil) - :tls (or (str/to-bool (environ/env :email-tls)) nil)} + ;; "" defaults on purpose, NOT nil. docker-compose.yaml passes all three as + ;; ${VAR:-} -- explicitly empty -- whenever email is unconfigured, which is + ;; the default deployment. Handing postal nil there changes the failure from + ;; MailConnectException ("Couldn't connect to host, port: localhost, 587") + ;; to a bare NullPointerException, measured. Both fail, but one says why. + ;; + ;; Keeping "" also preserves whatever postal does with an empty :user/:pass + ;; versus nil, which differs for SMTP AUTH. This is deliberately byte-identical + ;; to the pre-orcpub.env behaviour; the blank rule is right everywhere else, + ;; and here the old value was load-bearing for a third-party library. + ;; + ;; The real gap is that nothing checks whether email is configured at all -- + ;; .env.example says "Leave EMAIL_SERVER_URL empty to disable email + ;; functionality" and no code implements that. Worth doing, not here. + {:user (env/value :email-access-key "") + :pass (env/value :email-secret-key "") + :host (env/value :email-server-url "") + :port (Integer/parseInt (env/value :email-server-port "587")) + :ssl (or (str/to-bool (env/value :email-ssl)) nil) + :tls (or (str/to-bool (env/value :email-tls)) nil)} (catch NumberFormatException e (throw (ex-info "Invalid email server port configuration. Expected a number." {:error :invalid-port - :port (environ/env :email-server-port)} + :port (env/value :email-server-port)} e))))) (defn emailfrom @@ -363,7 +409,7 @@ - Throttles: one email per unique error fingerprint per 5 minutes - Extracts Pedestal interceptor metadata as a separate section" [context exception] - (when (not-empty (environ/env :email-errors-to)) + (when (env/value :email-errors-to) (let [data-map (ex-data exception) pedestal? (pedestal-wrapper? data-map) real-ex (if pedestal? (:exception data-map) exception) @@ -378,7 +424,7 @@ (let [result (postal/send-message (email-cfg) {:from (str branding/app-name " Errors <" (emailfrom) ">") - :to (str (environ/env :email-errors-to)) + :to (str (env/value :email-errors-to)) :subject (email-subject real-ex request) :body [{:type "text/plain" :content (build-body request real-ex pedestal-meta)}]})] diff --git a/src/clj/orcpub/env.clj b/src/clj/orcpub/env.clj new file mode 100644 index 000000000..9bd5965a0 --- /dev/null +++ b/src/clj/orcpub/env.clj @@ -0,0 +1,64 @@ +(ns orcpub.env + "The one way to read an environment value. + + Exists because the same defect was found independently at five sites, which + is what a missing abstraction looks like. The rule is one line -- A BLANK + VALUE IS AN ABSENT VALUE -- and it is not the obvious thing to write: + + (or (env :app-name) \"OrcPub\") + + reads correctly and is wrong. Environ returns \"\" for a variable that is + exported but empty, and \"\" is TRUTHY in Clojure, so it wins the `or` and the + default never applies. .env.example ships nine keys with empty values, so + this is the documented state of an unset optional setting, not an edge case. + + What that cost, measured before this namespace existed: + + SIGNATURE= tokens signed and VERIFIED against the empty string. The + guard meant to catch it was (when-not jwt-secret ...), a + nil check, so a blank secret walked past it and forged + tokens were accepted. See routes.clj. + DATOMIC_URL= get-datomic-uri returned \"?password=\" -- not a URI. + DATOMIC_PASSWORD= \"?password=\" appended to an otherwise valid URI. + CSP_POLICY= silently selected the permissive fallback rather than the + documented strict default. + EMAIL_SERVER_PORT= (Integer/parseInt \"\") threw at send time. + + Several of those sites already guarded with not-empty -- on the System/getenv + branch, while leaving the (env ...) branch bare. Environ reads environment + variables itself and answers first, so the guard sat on the path that never + runs. Being careful was not enough; the care went to the wrong line. + + A helper alone does not fix this. orcpub.config already had a `signature` + accessor and routes.clj read (environ/env :signature) raw anyway, four times, + which is how the token bug survived. So .clj-kondo/config.edn marks + environ.core/env and System/getenv as discouraged everywhere except here, and + `lein lint` fails the build on them. The rule is the enforcement; this + namespace is only where the exception lives. + + Values are trimmed, matching config/read-secret: a value that is only + whitespace is not one." + (:require [clojure.string :as str] + [environ.core :as environ])) + +(defn value + "The environment value for `k`, or nil when unset, empty or whitespace. + + With `default`, returns it in place of nil. Prefer this over (or (value k) d) + so the blank rule is applied before the default, not after." + ([k] + (some-> (environ/env k) str/trim not-empty)) + ([k default] + (or (value k) default))) + +(defn flag? + "True when `k` is exactly \"true\", case-insensitively. Everything else -- \"yes\", + \"1\", blank, a typo -- is false. + + Matches the server's own comparison so callers cannot invent their own + truthiness. equalsIgnoreCase compares per character rather than by locale + casing rules, so it is immune to the Turkish dotless-i that this branch + exists to fix; the literal goes first so a nil value returns false rather + than throwing." + [k] + (.equalsIgnoreCase "true" (or (value k) ""))) diff --git a/src/clj/orcpub/fork/branding.clj b/src/clj/orcpub/fork/branding.clj index 18e6a4fb2..d226e6480 100644 --- a/src/clj/orcpub/fork/branding.clj +++ b/src/clj/orcpub/fork/branding.clj @@ -5,69 +5,67 @@ Server-side (.clj) is the source of truth. Client-side branding is delivered via the config bridge: index.clj injects client-config as window.__BRANDING__ JSON in , and branding.cljs reads it." - (:require [environ.core :refer [env]]) + (:require [orcpub.env :as env]) (:import [java.time Year])) ;; ─── App Identity ────────────────────────────────────────────────── (def app-name "Full display name. Used in emails, OG tags, page titles." - (or (env :app-name) "OrcPub")) + (env/value :app-name "OrcPub")) (def app-tagline "One-line description for OG/meta tags." - (or (env :app-tagline) - "D&D 5e character builder/generator and digital character sheet far beyond any other in the multiverse.")) + (env/value :app-tagline "D&D 5e character builder/generator and digital character sheet far beyond any other in the multiverse.")) (def app-url "Primary application URL for legal pages and external references. Empty = hidden." - (or (env :app-url) "")) + (env/value :app-url "")) (def default-page-title "Default and og:title when no page-specific title is set." - (or (env :app-page-title) - (str app-name ": D&D 5e Character Builder/Generator"))) + (env/value :app-page-title (str app-name ": D&D 5e Character Builder/Generator"))) ;; ─── Logos & Images ──────────────────────────────────────────────── (def logo-path "Path to the main SVG logo (splash page, header, privacy page)." - (or (env :app-logo-path) "/image/orcpub-logo.svg")) + (env/value :app-logo-path "/image/orcpub-logo.svg")) (def og-image-filename "Filename for the OG meta image (social sharing preview). Combined with the request host to form the full URL." - (or (env :app-og-image) "/image/orcpub-logo.png")) + (env/value :app-og-image "/image/orcpub-logo.png")) ;; ─── Copyright ───────────────────────────────────────────────────── (def copyright-holder "Entity name shown in legal footer." - (or (env :app-copyright-holder) "OrcPub")) + (env/value :app-copyright-holder "OrcPub")) (def copyright-year "Copyright year string. Defaults to the current year." - (or (env :app-copyright-year) (str (.getValue (Year/now))))) + (env/value :app-copyright-year (str (.getValue (Year/now))))) ;; ─── Email ───────────────────────────────────────────────────────── (def email-sender-name "Display name for outbound emails (verification, password reset)." - (or (env :app-email-sender-name) (str app-name " Team"))) + (env/value :app-email-sender-name (str app-name " Team"))) (def email-from-address "From address for outbound emails. Falls back to env EMAIL_FROM_ADDRESS." - (or (env :email-from-address) "no-reply@orcpub.com")) + (env/value :email-from-address "no-reply@orcpub.com")) ;; ─── Support & Help ────────────────────────────────────────────── (def support-email "Contact email shown on privacy page, error messages, etc. Empty = hidden." - (or (env :app-support-email) "")) + (env/value :app-support-email "")) (def help-url "URL for the help/FAQ page. Empty string = hidden." - (or (env :app-help-url) "")) + (env/value :app-help-url "")) ;; ─── Social Links ────────────────────────────────────────────────── ;; Each link appears in the header/footer when non-empty. @@ -77,18 +75,18 @@ (def social-links "Map of social platform links. Empty string = hidden." - {:patreon (or (env :app-social-patreon) "") - :facebook (or (env :app-social-facebook) "") - :bluesky (or (env :app-social-bluesky) "") - :twitter (or (env :app-social-twitter) "") - :reddit (or (env :app-social-reddit) "") - :discord (or (env :app-social-discord) "")}) + {:patreon (env/value :app-social-patreon "") + :facebook (env/value :app-social-facebook "") + :bluesky (env/value :app-social-bluesky "") + :twitter (env/value :app-social-twitter "") + :reddit (env/value :app-social-reddit "") + :discord (env/value :app-social-discord "")}) ;; ─── Footer ───────────────────────────────────────────────────── (def copyright-url "URL for copyright holder name in footer. Empty string = plain text." - (or (env :app-copyright-url) "")) + (env/value :app-copyright-url "")) ;; ─── UI Behavior ──────────────────────────────────────────────── @@ -105,9 +103,9 @@ (def field-limits "Max-length constraints for form input fields." - {:notes (or (some-> (env :app-field-limit-notes) Integer/parseInt) 50000) - :text (or (some-> (env :app-field-limit-text) Integer/parseInt) 255) - :number (or (some-> (env :app-field-limit-number) Integer/parseInt) 7)}) + {:notes (or (some-> (env/value :app-field-limit-notes) Integer/parseInt) 50000) + :text (or (some-> (env/value :app-field-limit-text) Integer/parseInt) 255) + :number (or (some-> (env/value :app-field-limit-number) Integer/parseInt) 7)}) ;; ─── Client-Side Config Bridge ─────────────────────────────────── ;; index.clj injects this as window.__BRANDING__ JSON in <head>. diff --git a/src/clj/orcpub/fork/integrations.clj b/src/clj/orcpub/fork/integrations.clj index 2ac4269b0..c93353a64 100644 --- a/src/clj/orcpub/fork/integrations.clj +++ b/src/clj/orcpub/fork/integrations.clj @@ -2,12 +2,12 @@ "Optional third-party <head> integrations. Configure via environment variables; disabled when unset. Fork overrides: uncomment examples and add real service config." - (:require [environ.core :refer [env]])) + (:require [orcpub.env :as env])) ;; ─── How to add an integration ─────────────────────────────────────── ;; ;; 1. Define env-var-gated config: -;; (def my-service-id (env :my-service-id)) +;; (def my-service-id (env/value :my-service-id)) ;; ;; 2. Write a tag function that returns hiccup (or nil when disabled): ;; (defn- my-service-tag [nonce] diff --git a/src/clj/orcpub/fork/privacy_content.clj b/src/clj/orcpub/fork/privacy_content.clj index f49e08ea7..51e65eebf 100644 --- a/src/clj/orcpub/fork/privacy_content.clj +++ b/src/clj/orcpub/fork/privacy_content.clj @@ -2,7 +2,6 @@ "Fork-specific privacy policy content. Public/community edition: standard privacy policy." (:require [clojure.string :as s] - [environ.core :as environ] [orcpub.fork.branding :as branding])) (def privacy-policy-section @@ -59,8 +58,8 @@ {:title "What choices do you have about your information?" :font-size 32 :paragraphs - (if (not (s/blank? (environ/env :email-access-key))) - ["You may close your account at any time by emailing " (environ/env :email-access-key) (str "We will then inactivate your account and remove your content from " branding/app-name ". We may retain archived copies of you information as required by law or for legitimate business purposes (including to help address fraud and spam). ")] + (if (not (s/blank? branding/support-email)) + ["You may close your account at any time by emailing " branding/support-email (str "We will then inactivate your account and remove your content from " branding/app-name ". We may retain archived copies of you information as required by law or for legitimate business purposes (including to help address fraud and spam). ")] [(str "You may remove any content you create from " branding/app-name " at any time, although we may retain archived copies of the information. You may also disable sharing of content you create at any time, whether publicly shared or privately shared with specific users.") "Also, we support the Do Not Track browser setting."])} {:title "Our policy on children's information" @@ -71,8 +70,8 @@ :font-size 32 :paragraphs [(str "We may change this policy from time to time, and if we do we'll post any changes on this page. If you continue to use " branding/app-name " after those changes are in effect, you agree to the revised policy. If the changes are significant, we may provide more prominent notice or get your consent as required by law.")]} - (when (not (s/blank? (environ/env :email-access-key))) + (when (not (s/blank? branding/support-email)) {:title "How can you contact us?" :font-size 32 :paragraphs - ["You can contact us by emailing " (environ/env :email-access-key) ]})]}) + ["You can contact us by emailing " branding/support-email ]})]}) diff --git a/src/clj/orcpub/index.clj b/src/clj/orcpub/index.clj index be80b49ba..4523da422 100644 --- a/src/clj/orcpub/index.clj +++ b/src/clj/orcpub/index.clj @@ -6,13 +6,13 @@ [orcpub.dnd.e5.views-2 :as views-2] [orcpub.favicon :as fi] [orcpub.fork.integrations :as integrations] - [environ.core :refer [env]])) + [orcpub.env :as env])) (def homebrew-url "URL to fetch server-hosted .orcbrew plugins from on first load. Set LOAD_HOMEBREW_URL to enable (e.g. \"/homebrew.orcbrew\" or a full URL). When unset, no fetch is attempted — plugins come only from local imports." - (env :load-homebrew-url)) + (env/value :load-homebrew-url)) (defn meta-tag [property content] (when content @@ -153,8 +153,8 @@ html { [:img {:src "/image/spiral.gif" :style "height:200px;width:200px;margin-top:200px"}]])] (include-css "/css/compiled/styles.css") - ;; Dev mode uses Report-Only CSP (logs violations but doesn't block) - ;; Prod mode uses enforcing CSP with nonces + ;; Every script tag carries the per-request nonce. It is nil in dev mode, + ;; where no CSP header is set at all; enforcing otherwise. (script-tag {:src "/js/compiled/orcpub.js" :nonce nonce}) (script-tag {:src "/js/cookies.js" :nonce nonce}) (include-css "/assets/font-awesome/5.13.1/css/all.min.css") diff --git a/src/clj/orcpub/pedestal.clj b/src/clj/orcpub/pedestal.clj index ad0104f37..05705dc4e 100644 --- a/src/clj/orcpub/pedestal.clj +++ b/src/clj/orcpub/pedestal.clj @@ -11,7 +11,8 @@ [orcpub.config :as config] [orcpub.fork.integrations :as integrations]) (:import [java.io File] - [java.time.format DateTimeFormatter])) + [java.time.format DateTimeFormatter] + [java.util Locale])) (defn test? [service-map] @@ -37,7 +38,11 @@ nil) (def rfc822-formatter - (DateTimeFormatter/ofPattern "EEE, dd MMM yyyy HH:mm:ss Z")) + ;; Locale/ENGLISH is load-bearing. HTTP dates are always English (RFC 7231), + ;; but ofPattern without a locale parses using the JVM default, which follows + ;; the OS regional settings. On a non-English machine "Mon" is not a day name + ;; and parse-date throws, which used to blank the response entirely. + (DateTimeFormatter/ofPattern "EEE, dd MMM yyyy HH:mm:ss Z" Locale/ENGLISH)) (defn parse-date [date content-length] (when date @@ -50,14 +55,19 @@ (defn make-nonce-interceptor "Creates an interceptor that generates per-request CSP nonces. - In prod (dev-mode?=false) with CSP_POLICY=strict: + When dev-mode? is false -- which is the DEFAULT, not just production -- + and CSP_POLICY=strict: - :enter phase generates a nonce and stores it in [:request :csp-nonce] - :leave phase adds enforcing Content-Security-Policy header with the nonce - In dev mode: CSP is skipped entirely. Pedestal 0.7's default CSP is still - active, but the nonce interceptor becomes a no-op. This avoids flooding the - browser console with Report-Only violations (inline Figwheel scripts, etc.) - that obscure real issues during development." + In dev mode: no nonce is generated, so the :leave branch never fires and + this interceptor sets no CSP header. Pedestal's own CSP is disabled in the + strict branch of get-secure-headers-config, so dev runs with no CSP from + this application -- which is what lets Figwheel's scripts and its websocket + work. + + There is no Report-Only mode anywhere in this codebase, despite what earlier + comments here claimed." [dev-mode?] (interceptor/interceptor {:name :nonce-interceptor @@ -69,6 +79,9 @@ (if-let [nonce (get-in ctx [:request :csp-nonce])] (assoc-in ctx [:response :headers "Content-Security-Policy"] (csp/build-csp-header nonce + ;; Always false here, and not a mistake: :enter only + ;; makes a nonce when dev-mode? is false, so this + ;; branch is unreachable in dev mode. :dev-mode? false :extra-connect-src (:connect-src integrations/csp-domains) :extra-frame-src (:frame-src integrations/csp-domains))) @@ -100,7 +113,12 @@ (if new-etag (assoc-in context [:response :headers "etag"] new-etag) context))) - (catch Throwable t (log/error :msg "ETag interceptor error" :exception t))))})) + ;; Return the context. Without it the catch yields log/error's + ;; value, discarding the response: the client gets 200 with an + ;; empty body and no headers, and nothing reports a problem. + (catch Throwable t + (log/error :msg "ETag interceptor error" :exception t) + context)))})) (defrecord Pedestal [service-map conn service] component/Lifecycle diff --git a/src/clj/orcpub/routes.clj b/src/clj/orcpub/routes.clj index 3e104a68c..cf8fa3d8e 100644 --- a/src/clj/orcpub/routes.clj +++ b/src/clj/orcpub/routes.clj @@ -32,6 +32,7 @@ [orcpub.route-map :as route-map] [orcpub.errors :as errors] [orcpub.privacy :as privacy] + [orcpub.config :as config] [orcpub.email :as email] [orcpub.index :refer [index-page]] [orcpub.pdf :as pdf] @@ -46,6 +47,7 @@ [orcpub.routes.folder :as folder] [hiccup.page :as page] [environ.core :as environ] + [orcpub.env :as env] [clojure.set :as sets] [ring.middleware.head :as head] [ring.util.codec :as codec] @@ -66,12 +68,66 @@ (def ^:private jwt-secret "JWT signing secret from SIGNATURE env var. - nil when unset — check-auth returns 500 with a diagnostic message." - (environ/env :signature)) + nil when unset OR BLANK — check-auth returns 500 with a diagnostic message. + + Read through config/signature, NOT the environment directly. That accessor + checks /run/secrets/signature before SIGNATURE, which is what the Docker + secrets setup in docker-compose.yaml promises -- that comment says the app + checks /run/secrets/ first and falls back to the environment. Reading the + env var here meant a deployment that followed those instructions -- mount the + secret, drop the variable -- got nil, and every authenticated call and token + operation returned 500 while a perfectly good secret sat on disk. + + The blank check is load-bearing, and its absence defeated the warning below. + It now lives in config/signature, which routes both sources through + orcpub.env/value. + An exported-but-empty SIGNATURE= yields \"\", which is TRUTHY in Clojure, so + it sailed past `when-not jwt-secret` — the guard written for exactly this — + and was handed to buddy. Measured: buddy signs AND verifies with \"\" without + complaint, so the app issued and accepted tokens signed with a publicly + known empty secret, and anyone could forge one for any user. + + Clearing a line in .env is an ordinary thing to do; .env.example ships nine + keys with empty values." + (config/signature)) (when-not jwt-secret (println "WARNING: SIGNATURE env var is not set — all authenticated API calls will fail")) +(defn- report-registration-mode! + "Say at startup what registration will actually do, because every wrong answer + here is silent. + + Printed at namespace load, beside the SIGNATURE warning above, because this + branch has no boot report to hang it on. If one is added later, move it there + -- it belongs with the rest of the effective configuration." + [] + (let [smtp? (email/configured?) + opted-out? (email/unverified-registration-allowed?)] + (cond + (and (not smtp?) opted-out?) + (do (println "WARNING: registration is running WITHOUT EMAIL VERIFICATION.") + (println " EMAIL_SERVER_URL is unset and ALLOW_UNVERIFIED_REGISTRATION=true,") + (println " so anyone who registers is verified on the spot and nobody proves") + (println " they own the address they typed. Intended for a private instance.") + (println " Set EMAIL_SERVER_URL to restore verification.")) + + (not smtp?) + (do (println "WARNING: registration is DISABLED — EMAIL_SERVER_URL is unset, so no") + (println " verification email can be sent. Existing users are unaffected.") + (println " Set EMAIL_SERVER_URL, or ALLOW_UNVERIFIED_REGISTRATION=true to") + (println " accept accounts without verifying the address.")) + + opted-out? + ;; The loaded gun: inert today, decides policy the day SMTP goes missing. + (do (println "WARNING: ALLOW_UNVERIFIED_REGISTRATION is set but has no effect right now,") + (println " because EMAIL_SERVER_URL is configured. If that value is ever lost") + (println " — a typo, a dropped deploy variable, a failed secret mount — this") + (println " flag silently turns registration into OPEN registration instead of") + (println " failing. Remove it unless this is a private instance."))))) + +(report-registration-mode!) + (def backend (backends/jws {:secret jwt-secret})) (defn first-user-by [db query value] @@ -230,7 +286,7 @@ (defn create-token [username exp] (jwt/sign {:user username :exp exp} - (environ/env :signature))) + jwt-secret)) (defn following-usernames [db ids] (map :orcpub.user/username @@ -323,24 +379,137 @@ params verification-key)) -(defn do-verification [request params conn & [tx-data]] - (let [verification-key (str (java.util.UUID/randomUUID)) - now (java.util.Date.)] +(defn do-verification + "Create or refresh a pending verification, then email the link. + + The write has to happen BEFORE the send, because the emailed link only + resolves if the key is already stored. Datomic does not roll back, so the + send is wrapped and the write undone if it fails. + + Without that rollback a failed email left a committed, unverified account, + and `register` validates against existing username/email -- so the retry this + very function tells the user to make then failed with \"already taken\". + + Not a lockout: `re-verify` works on exactly that orphaned state and is wired + to a button in the UI, so a user who finds it recovers. Measured, because an + earlier version of this docstring claimed otherwise. It is a dead end from the + registration form with a non-obvious escape, which is also why seven years of + production never surfaced it -- live SMTP works, so this runs only on a + transient send failure, and the few users it reaches report \"it says my email + already exists\", indistinguishable from forgetting an account. + + `request-email-change` already did exactly this (retracting pending-email on + send failure, covered by email-change-test/test-email-send-failure-rolls-back). + Registration was never brought up to match. See + registration_rollback_test.clj and `git show agents/develop:docs/kb/blank-env-values.md`. + + docs/email-system.md describes this flow for operators, branch by branch. It + mirrors this function, so a change here needs a change there -- that doc is + what someone reads instead of this code." + [request params conn & [tx-data]] + (cond + ;; SMTP is gone but nobody asked for unverified registration. FAIL CLOSED. + ;; Keying auto-verify on "no SMTP" alone would silently turn a production + ;; site into open registration the moment a variable is typo'd, dropped by a + ;; deploy, or mounted empty -- a downgrade with no error and no alarm. + ;; Measured: " ", "" and absent entirely all read as "no email". Make the + ;; operator say so, and make the accident loud instead. + (and (not (email/configured?)) + (not (email/unverified-registration-allowed?))) + (do + (println "ERROR: registration unavailable — EMAIL_SERVER_URL is unset, so no" + "verification email can be sent. Set it, or set" + "ALLOW_UNVERIFIED_REGISTRATION=true to accept accounts without" + "verifying the address.") + ;; A response, not a throw. A throw reaches the client as a bare 500 it + ;; cannot tell apart from any other failure, so the form showed nothing. + {:status 503 :body {:error :email-not-configured}}) + + ;; Deliberately running without email: verify on the spot rather than + ;; promising a mail that cannot be sent. The operator of a mail-less + ;; instance is handing out the accounts themselves, so address ownership is + ;; not being proved by anyone anyway. + (not (email/configured?)) + (do + (println "INFO: EMAIL_SERVER_URL is unset — verifying" (:username params) + "on creation instead of sending a verification email.") + (try + @(d/transact conn [(merge tx-data {:orcpub.user/verified? true})]) + ;; The client branches on this to show "registration complete, you can + ;; log in" rather than "check your email". + {:status 200 :body {:verified? true}} + (catch Exception e + (println "ERROR: Failed to create account:" (.getMessage e)) + (throw (ex-info "Unable to complete registration. Please try again or contact support." + {:error :verification-failed} + e))))) + :else + (let [verification-key (str (java.util.UUID/randomUUID)) + now (java.util.Date.) + ;; re-verify passes an existing {:db/id id}; register does not. The two + ;; need different rollbacks -- never retract the ENTITY for a user who + ;; already existed, only the attributes this attempt set. + existing-id (:db/id tx-data) + ;; What a resend is about to overwrite. verification-key is + ;; cardinality-one, so the new transaction REPLACES the link already + ;; sitting in the user's inbox. If this send then fails, retracting the + ;; new key is not enough -- the old one has to come back, or a link that + ;; was still valid stops working because a later resend failed. + previous (when existing-id + (d/pull (d/db conn) + [:orcpub.user/verification-key :orcpub.user/verification-sent] + existing-id)) + tempid "verification-subject" + report (try + @(d/transact + conn + [(merge + tx-data + {:db/id (or existing-id tempid) + :orcpub.user/verified? false + :orcpub.user/verification-key verification-key + :orcpub.user/verification-sent now})]) + (catch Exception e + (println "ERROR: Failed to create verification record:" (.getMessage e)) + (throw (ex-info "Unable to complete registration. Please try again or contact support." + {:error :verification-failed} + e)))) + eid (or existing-id (get (:tempids report) tempid))] (try - @(d/transact - conn - [(merge - tx-data - {:orcpub.user/verified? false - :orcpub.user/verification-key verification-key - :orcpub.user/verification-sent now})]) (send-verification-email request params verification-key) {:status 200} - (catch Exception e - (println "ERROR: Failed to create verification record:" (.getMessage e)) + (catch Throwable e + (println "ERROR: Verification email failed, rolling back:" (.getMessage e)) + (try + @(d/transact conn (if existing-id + ;; Put back what was there, or remove what we added -- + ;; but ONLY while the values are still ours. Two + ;; resends can overlap: if a newer one wrote its key + ;; and emailed it after we wrote ours, restoring the + ;; old key would kill the link actually sitting in + ;; the inbox. :db/cas makes the restore conditional + ;; and the whole transaction atomic; a retract of a + ;; value that is no longer current is already a no-op. + (let [{old-key :orcpub.user/verification-key + old-sent :orcpub.user/verification-sent} previous] + [(if old-key + [:db/cas eid :orcpub.user/verification-key verification-key old-key] + [:db/retract eid :orcpub.user/verification-key verification-key]) + (if old-sent + [:db/cas eid :orcpub.user/verification-sent now old-sent] + [:db/retract eid :orcpub.user/verification-sent now])]) + [[:db/retractEntity eid]])) + (catch Exception re + (if (re-find #"cas-failed" (str re (some-> re .getCause))) + ;; Not a failure: a newer resend superseded this attempt, so its + ;; state is the right state to keep. + (println "INFO: verification rollback skipped — a newer resend owns the key now.") + ;; Report the rollback failure, but surface the original cause. + (println "ERROR: Rollback ALSO failed; a partial account may remain:" + (.getMessage re))))) (throw (ex-info "Unable to complete registration. Please try again or contact support." - {:error :verification-failed} - e)))))) + {:error :verification-email-failed} + e))))))) (defn register [{:keys [json-params db conn] :as request}] (let [{:keys [username email password send-updates?]} json-params @@ -457,7 +626,7 @@ Stateless — no DB storage needed. Verified by checking JWT signature." [email] (jwt/sign {:email (s/lower-case email) :action "unsubscribe"} - (environ/env :signature))) + jwt-secret)) (defn unsubscribe "GET handler for /unsubscribe?token=<jwt>. @@ -468,7 +637,7 @@ (if (s/blank? token) {:status 400 :body "Missing token"} (try - (let [{:keys [email action]} (jwt/unsign token (environ/env :signature))] + (let [{:keys [email action]} (jwt/unsign token jwt-secret)] (if (not= "unsubscribe" action) {:status 400 :body "Invalid token"} (let [{:keys [:db/id]} (user-for-email (d/db conn) email)] diff --git a/src/clj/orcpub/system.clj b/src/clj/orcpub/system.clj index c221c047f..d1cc240b2 100644 --- a/src/clj/orcpub/system.clj +++ b/src/clj/orcpub/system.clj @@ -1,5 +1,6 @@ (ns orcpub.system - (:require [com.stuartsierra.component :as component] + (:require [orcpub.env :as env] + [com.stuartsierra.component :as component] [reloaded.repl :as rrepl] [io.pedestal.http :as http] [orcpub.pedestal :as pedestal] @@ -9,8 +10,31 @@ [environ.core :as environ]) (:import (org.eclipse.jetty.server.handler.gzip GzipHandler))) +(defn- configured-port + "The port to bind, from the PORT environment variable, defaulting to 8890. + + Shared by both service maps on purpose. The dev map used to pin a literal + 8890 while prod read PORT, so PORT=9000 in .env moved the production server + and silently did nothing in dev -- and scripts/common.sh, which reads the + same PORT, then probed, reported and stopped a port nothing was listening on. + .env.example documents PORT with no hint that it only applies to one of them." + [] + ;; Blank counts as unset. An (or ...) on getenv is not enough: the empty + ;; string is truthy in Clojure, so a .env carrying a bare `PORT=` yielded it and + ;; threw here -- and because both service maps are top-level defs, that throws + ;; while the namespace LOADS, not when the server starts. An empty value in a + ;; config template is a normal thing for a user to leave behind. + (let [port-str (env/value :port "8890")] + (try + (Integer/parseInt port-str) + (catch NumberFormatException e + (throw (ex-info "Invalid PORT environment variable. Expected a number." + {:error :invalid-port + :port port-str} + e)))))) + (def dev-service-map-overrides - {::http/port 8890 + {::http/port (configured-port) ;; Bind to loopback only in dev (don't expose to LAN) ::http/host "localhost" ;; do not block thread that starts web server @@ -34,14 +58,7 @@ ::http/host "0.0.0.0" ;; Pedestal 0.7+ requires explicit interceptor coercion for maps/functions ::http/enable-session false ; Disable default session handling if not needed - ::http/port (let [port-str (or (System/getenv "PORT") "8890")] - (try - (Integer/parseInt port-str) - (catch NumberFormatException e - (throw (ex-info "Invalid PORT environment variable. Expected a number." - {:error :invalid-port - :port port-str} - e))))) + ::http/port (configured-port) ::http/join false ::http/resource-path "/public" ;; CSP configured via CSP_POLICY env var (strict|permissive|none) diff --git a/src/cljc/orcpub/common.cljc b/src/cljc/orcpub/common.cljc index 572a0ff6d..6660ddc84 100644 --- a/src/cljc/orcpub/common.cljc +++ b/src/cljc/orcpub/common.cljc @@ -5,10 +5,30 @@ (def dot-char "•") +(defn ascii-lower-case + "Lowercase without asking the operating system what language it is in. + + clojure.string/lower-case calls .toLowerCase() with no Locale on the JVM, + which follows the JVM default. On a Turkish or Azerbaijani machine that + folds \"I\" to the DOTLESS \"ı\", so \"Illusory Script\" becomes + :ıllusory-script instead of :illusory-script -- a different key, on the + server only, for the same content. Names, keys and search terms are + machine tokens here, not prose. + + ClojureScript needs no guard: JS toLowerCase() is already locale-invariant + (toLocaleLowerCase() is the one that is not), so the browser was always + correct and only the JVM side diverged. + + See docs/kb/locale-safety.md." + [x] + (let [t (str x)] + #?(:clj (.toLowerCase ^String t java.util.Locale/ROOT) + :cljs (.toLowerCase t)))) + (defn- name-to-kw-aux [name ns] (when (string? name) (as-> name $ - (s/lower-case $) + (ascii-lower-case $) (s/replace $ #"'" "") (s/replace $ #"\W" "-") (s/replace $ #"\-+" "-") @@ -204,8 +224,9 @@ ;; Case Insensitive `sort-by` (defn aloof-sort-by [sorter coll] - (sort-by (comp s/lower-case sorter) coll) - ) + ;; ascii-lower-case, so a list does not reorder itself depending on the + ;; server's locale. + (sort-by (comp ascii-lower-case sorter) coll)) (defn ->kebab-case [s] (-> s diff --git a/src/cljc/orcpub/dnd/e5/char_filter.cljc b/src/cljc/orcpub/dnd/e5/char_filter.cljc index bf73eaadd..7b1761321 100644 --- a/src/cljc/orcpub/dnd/e5/char_filter.cljc +++ b/src/cljc/orcpub/dnd/e5/char_filter.cljc @@ -1,5 +1,6 @@ (ns orcpub.dnd.e5.char-filter (:require [clojure.string :as s] + [orcpub.common :as common] [orcpub.dnd.e5.character :as char5e])) (defn char-matches? @@ -14,8 +15,10 @@ [char name-filter level-filters class-filters has-portrait? has-faction-pic?] (and (or (s/blank? name-filter) - (s/includes? (s/lower-case (or (::char5e/character-name char) "")) - (s/lower-case name-filter))) + ;; ascii-lower-case: on a Turkish JVM "GIM" folds to "gım" and matches + ;; no character called Gimli. + (s/includes? (common/ascii-lower-case (or (::char5e/character-name char) "")) + (common/ascii-lower-case name-filter))) (or (empty? level-filters) (some #(level-filters (::char5e/level %)) (::char5e/classes char))) (or (empty? class-filters) diff --git a/src/cljc/orcpub/dnd/e5/compute.cljc b/src/cljc/orcpub/dnd/e5/compute.cljc index 7aa8fc083..808c35085 100644 --- a/src/cljc/orcpub/dnd/e5/compute.cljc +++ b/src/cljc/orcpub/dnd/e5/compute.cljc @@ -64,10 +64,12 @@ (defn filter-by-name-xform "Returns a transducer that filters items by name matching filter-text." [filter-text name-key] - (let [pattern (re-pattern (str ".*" (s/lower-case filter-text) ".*"))] + ;; ascii-lower-case: on a Turkish JVM "FIRE" folds to "fıre" and matches + ;; neither Fireball nor Fire Bolt. + (let [pattern (re-pattern (str ".*" (common/ascii-lower-case filter-text) ".*"))] (filter (fn [x] - (re-matches pattern (s/lower-case (name-key x))))))) + (re-matches pattern (common/ascii-lower-case (name-key x))))))) (defn filter-spells "Filters and sorts spells whose :name matches filter-text." diff --git a/src/cljc/orcpub/entity.cljc b/src/cljc/orcpub/entity.cljc index 9412a8fa0..a6f065514 100644 --- a/src/cljc/orcpub/entity.cljc +++ b/src/cljc/orcpub/entity.cljc @@ -698,9 +698,12 @@ :args (spec/cat :raw-entity ::raw-entity :modifier-map ::t/template) :ret any?) -(defn name-to-kw [name] +(defn name-to-kw + "Second implementation of name->keyword, alongside orcpub.common/name-to-kw. + Locale-pinned for the same reason: see orcpub.common/ascii-lower-case." + [name] (-> name - s/lower-case + common/ascii-lower-case (s/replace #"\W" "-") keyword)) diff --git a/src/cljs/orcpub/dnd/e5/events.cljs b/src/cljs/orcpub/dnd/e5/events.cljs index 98bea8c97..3edecbf28 100644 --- a/src/cljs/orcpub/dnd/e5/events.cljs +++ b/src/cljs/orcpub/dnd/e5/events.cljs @@ -1857,14 +1857,24 @@ (reg-event-db :register-success (fn [db [_ backtrack? response]] - (-> db - (update :user-data merge (:body response)) - (assoc :route :verify-sent)))) + ;; A deployment with no EMAIL_SERVER_URL verifies on creation and says so + ;; with :verified? -- sending such a user to "check your email" would point + ;; them at a mail that is never coming. + (let [verified? (get-in response [:body :verified?])] + (-> db + (update :user-data merge (:body response)) + (assoc :route (if verified? :verify-success :verify-sent)))))) (reg-event-fx :register-failure (fn [cofx [_ response]] - {:dispatch [:clear-login]})) + ;; This used to clear login state and nothing else, so every server-side + ;; failure -- including registration being switched off -- left the form + ;; looking as if nothing had happened. + (dispatch-login-failure + (if (= :email-not-configured (get-in response [:body :error])) + "Registration is currently unavailable. Please contact the site administrator." + "Registration failed. Please try again.")))) #_ ;; dead stub — real impl is orcpub.registration/validate-registration (defn validate-registration []) @@ -1948,8 +1958,13 @@ (reg-event-db :re-verify-success - (fn [db []] - (assoc db :route routes/verify-sent-route))) + (fn [db [_ response]] + ;; With no SMTP and ALLOW_UNVERIFIED_REGISTRATION set, a resend verifies the + ;; account on the spot and says so -- "check your email" would leave the user + ;; waiting for a message that is never sent. + (assoc db :route (if (get-in response [:body :verified?]) + routes/verify-success-route + routes/verify-sent-route)))) (reg-event-fx :re-verify diff --git a/src/cljs/orcpub/dnd/e5/views.cljs b/src/cljs/orcpub/dnd/e5/views.cljs index f233ca2e8..aec4d38c4 100644 --- a/src/cljs/orcpub/dnd/e5/views.cljs +++ b/src/cljs/orcpub/dnd/e5/views.cljs @@ -920,6 +920,12 @@ [:span "Already have an account?"] (login-link)] [:div.m-t-10.m-b-20 [:span "After clicking JOIN A validation email will be sent to the above email address."]] + (when @(subscribe [:login-message-shown?]) + [:div.m-t-5.p-r-5.p-l-5 + [message + :error + @(subscribe [:login-message]) + hide-login-message]]) [:button.form-button {:style {:height "40px" :width "174px" diff --git a/test/clj/orcpub/config_test.clj b/test/clj/orcpub/config_test.clj new file mode 100644 index 000000000..12dcff46f --- /dev/null +++ b/test/clj/orcpub/config_test.clj @@ -0,0 +1,57 @@ +(ns orcpub.config-test + "Pins the locale-independence of the CSP config tokens. + + CSP_POLICY and DEV_MODE are ASCII protocol tokens, not prose. Folding their + case with the default locale means a Turkish machine reads STRICT as + \"strıct\" (dotless i), matches no branch, and silently falls through to the + PERMISSIVE policy -- a security downgrade nobody asked for and nothing + reports. These tests run under a Turkish locale on purpose." + (:require [clojure.test :refer [deftest testing is use-fixtures]] + [orcpub.config :as config] + [environ.core]) + (:import [java.util Locale])) + +(def ^:private turkish (Locale/forLanguageTag "tr-TR")) + +(defn- with-locale + "Run f with the JVM default locale set to loc, then restore it. Restoring + matters: a leaked default would silently change how every later test in the + same JVM folds case." + [^Locale loc f] + (let [saved (Locale/getDefault)] + (try (Locale/setDefault loc) (f) + (finally (Locale/setDefault saved))))) + +(use-fixtures :once (fn [t] (let [saved (Locale/getDefault)] + (try (t) (finally (Locale/setDefault saved)))))) + +(deftest turkish-locale-does-not-break-csp-policy + (testing "an uppercase CSP_POLICY still resolves to strict under tr-TR" + (with-locale turkish + (fn [] + (with-redefs [environ.core/env {:csp-policy "STRICT"}] + (is (= "strict" (config/get-csp-policy)) + "STRICT lowercased with the Turkish locale yields \"strıct\" (dotless i)") + (is (true? (config/strict-csp?)) + "a mis-folded token falls through to the PERMISSIVE policy")))))) + +(deftest turkish-locale-does-not-break-dev-mode + (testing "DEV_MODE comparison is case-insensitive and locale-independent" + (with-locale turkish + (fn [] + (doseq [v ["true" "TRUE" "True"]] + (with-redefs [environ.core/env {:dev-mode v}] + (is (true? (config/dev-mode?)) (str "DEV_MODE=" v " should be true")))) + (doseq [v ["false" "FALSE" "" "yes" "1"]] + (with-redefs [environ.core/env {:dev-mode v}] + (is (false? (config/dev-mode?)) (str "DEV_MODE=" v " should be false")))))))) + +(deftest dev-mode-is-false-when-unset + (testing "an unset DEV_MODE is false, and does not throw" + (with-redefs [environ.core/env {}] + (is (false? (config/dev-mode?)))))) + +(deftest csp-policy-defaults-to-strict + (testing "no CSP_POLICY set means strict" + (with-redefs [environ.core/env {}] + (is (= "strict" (config/get-csp-policy)))))) diff --git a/test/clj/orcpub/env_test.clj b/test/clj/orcpub/env_test.clj new file mode 100644 index 000000000..ded2b4bae --- /dev/null +++ b/test/clj/orcpub/env_test.clj @@ -0,0 +1,78 @@ +(ns orcpub.env-test + "Pins the one rule orcpub.env exists to enforce: A BLANK VALUE IS ABSENT. + + Worth pinning rather than trusting, because the wrong version reads correctly. + (or (env :k) default) looks like it applies the default when the variable is + not set, and does not: environ returns \"\" for an exported-but-empty variable + and \"\" is truthy in Clojure, so the default is never reached. That shape was + written independently at five sites in this codebase. + + Each test below fails against the naive implementation. That is the point -- + a test that passes either way would not have caught any of the five." + (:require [clojure.test :refer [deftest testing is]] + [environ.core] + [orcpub.env :as env])) + +(defn- with-env + "Run f with environ/env redefined to m. Redefining environ rather than the + process environment because Java cannot set its own env vars." + [m f] + (with-redefs [environ.core/env m] (f))) + +(deftest blank-counts-as-absent + (testing "unset" + (with-env {} #(is (nil? (env/value :missing))))) + + (testing "empty string -- the case (or (env :k) d) gets wrong" + (with-env {:k ""} #(is (nil? (env/value :k))))) + + (testing "whitespace only, matching config/read-secret's trim" + (with-env {:k " "} #(is (nil? (env/value :k)))) + (with-env {:k "\t\n"} #(is (nil? (env/value :k)))))) + +(deftest real-values-survive + (testing "a value is returned unchanged" + (with-env {:k "hunter2"} #(is (= "hunter2" (env/value :k))))) + + (testing "surrounding whitespace is trimmed, inner whitespace is not" + (with-env {:k " a b "} #(is (= "a b" (env/value :k))))) + + (testing "a value that merely looks empty is still a value" + (with-env {:k "0"} #(is (= "0" (env/value :k)))) + (with-env {:k "false"} #(is (= "false" (env/value :k)))))) + +(deftest default-applies-to-blank-not-just-unset + (testing "unset takes the default" + (with-env {} #(is (= "8890" (env/value :port "8890"))))) + + (testing "EMPTY takes the default too -- the whole reason this namespace exists" + (with-env {:port ""} #(is (= "8890" (env/value :port "8890")))) + (with-env {:port " "} #(is (= "8890" (env/value :port "8890"))))) + + (testing "a real value beats the default" + (with-env {:port "9000"} #(is (= "9000" (env/value :port "8890")))))) + +(deftest flag-matches-the-servers-own-comparison + (testing "only the literal true, any case" + (doseq [v ["true" "TRUE" "True" " true "]] + (with-env {:f v} #(is (true? (env/flag? :f)) (str "expected true for " (pr-str v)))))) + + (testing "every other value is false, including the truthy-LOOKING ones" + (doseq [v ["yes" "1" "on" "tru" "false" "" " "]] + (with-env {:f v} #(is (false? (env/flag? :f)) (str "expected false for " (pr-str v)))))) + + (testing "unset is false" + (with-env {} #(is (false? (env/flag? :f)))))) + +(deftest turkish-locale-does-not-change-the-answer + ;; The branch this lands on exists because of locale-dependent case folding. + ;; flag? uses equalsIgnoreCase, which compares per character rather than by + ;; locale casing rules, so "TRUE" must not fold to "tr�e" or similar under tr-TR. + (let [saved (java.util.Locale/getDefault)] + (try + (java.util.Locale/setDefault (java.util.Locale/forLanguageTag "tr-TR")) + (with-env {:f "TRUE"} #(is (true? (env/flag? :f)) + "TRUE must still read as true on a Turkish JVM")) + (with-env {:k " STRICT "} #(is (= "STRICT" (env/value :k)) + "value trims but must not case-fold at all")) + (finally (java.util.Locale/setDefault saved))))) diff --git a/test/clj/orcpub/pedestal_test.clj b/test/clj/orcpub/pedestal_test.clj new file mode 100644 index 000000000..8a2d798ed --- /dev/null +++ b/test/clj/orcpub/pedestal_test.clj @@ -0,0 +1,106 @@ +(ns orcpub.pedestal-test + "Pins the two defects that made every /assets/* request return 200 with an + empty body on a non-English machine. + + 1. parse-date must read the English HTTP date regardless of JVM locale. + HTTP dates are always English (RFC 7231); an unlocalised + DateTimeFormatter parses them with the default locale, so \"Mon\" is not + a day name on a Spanish machine and it throws. + + 2. The ETag interceptor's catch must return the CONTEXT. Returning + log/error's value instead discards the response: Pedestal then has + nothing to write and Jetty emits a bare 200. That is what made defect 1 + silent -- the exception was logged, but the response was already gone." + (:require [clojure.test :refer [deftest testing is use-fixtures]] + [orcpub.pedestal :as pedestal]) + (:import [java.time ZonedDateTime] + [java.time.format DateTimeFormatter] + [java.util Locale])) + +(def ^:private hostile-locales + [(Locale/forLanguageTag "es-ES") + (Locale/forLanguageTag "de-DE") + (Locale/forLanguageTag "tr-TR") + (Locale/forLanguageTag "ja-JP")]) + +;; A real Last-Modified from the Font Awesome webjar, and the ETag the English +;; locale has always produced for it. Pinning the exact value matters: if it +;; ever changes, every cached ETag in the wild is invalidated. +(def ^:private sample-date "Mon, 06 Jul 2020 14:41:47 GMT") +(def ^:private expected-etag "1594046507000-58935") + +(use-fixtures :once (fn [t] (let [saved (Locale/getDefault)] + (try (t) (finally (Locale/setDefault saved)))))) + +(deftest parse-date-produces-the-expected-etag + (testing "the value is exactly what English-locale servers have always produced" + ;; A value regression guard, NOT a guard against the locale defect. See + ;; the next test for why an in-process test cannot catch that one. + (is (= expected-etag (pedestal/parse-date sample-date 58935))))) + +(deftest the-locale-hazard-this-fix-removes + (testing "an unlocalised formatter really does throw on a valid HTTP date" + ;; Why this is demonstrated rather than asserted against rfc822-formatter: + ;; that formatter is a top-level def, so its locale is fixed when the + ;; namespace LOADS -- before any test can call Locale/setDefault. A unit + ;; test in this JVM therefore cannot reproduce the original failure, and a + ;; test claiming to would pass whether or not the fix were present. + ;; + ;; The real guard is running this suite under a non-English JVM: + ;; lein test with -Duser.language=es -Duser.country=ES + ;; which is green. What this test pins is that the HAZARD is real, so + ;; nobody "simplifies" Locale/ENGLISH back out of the formatter. + (let [saved (Locale/getDefault)] + (try + (Locale/setDefault (Locale/forLanguageTag "es-ES")) + (let [unlocalised (DateTimeFormatter/ofPattern "EEE, dd MMM yyyy HH:mm:ss Z") + localised (DateTimeFormatter/ofPattern "EEE, dd MMM yyyy HH:mm:ss Z" Locale/ENGLISH) + text "Mon, 06 Jul 2020 14:41:47 +0000"] + (is (thrown? Exception (ZonedDateTime/parse text unlocalised)) + "if this stops throwing, the hazard is gone and this test can go") + (is (some? (ZonedDateTime/parse text localised)) + "pinning the locale is what makes it parse")) + (finally (Locale/setDefault saved)))))) + +(deftest parse-date-passes-through-nil + (testing "no Last-Modified header means no etag, not an exception" + (is (nil? (pedestal/parse-date nil 123))))) + +(defn- leave [ctx] + ((:leave pedestal/etag-interceptor) ctx)) + +(deftest etag-interceptor-returns-context-when-it-throws + (testing "a response is never discarded, whatever the interceptor hits" + ;; An unparseable Last-Modified makes parse-date throw, which is exactly + ;; what a non-English locale used to do with a perfectly valid header. + (let [ctx {:request {:headers {}} + :response {:status 200 + :body "hello" + :headers {"Last-Modified" "not a date at all" + "Content-Length" "5"}}} + out (leave ctx)] + (is (map? out) "the catch must return the context, not log/error's value") + (is (= 200 (get-in out [:response :status]))) + (is (= "hello" (get-in out [:response :body])) + "the body survived: discarding it is what produced an empty 200")))) + +(deftest etag-interceptor-sets-an-etag-on-a-good-response + (testing "the normal path still works" + (let [ctx {:request {:headers {}} + :response {:status 200 + :body "hello" + :headers {"Last-Modified" sample-date + "Content-Length" "58935"}}} + out (leave ctx)] + (is (= expected-etag (get-in out [:response :headers "etag"])))))) + +(deftest etag-interceptor-honours-if-none-match + (testing "a matching if-none-match yields 304 with no body" + (let [ctx {:request {:headers {"if-none-match" expected-etag}} + :response {:status 200 + :body "hello" + :headers {"Last-Modified" sample-date + "Content-Length" "58935"}}} + out (leave ctx)] + (is (= 304 (get-in out [:response :status]))) + (is (nil? (get-in out [:response :body])))))) diff --git a/test/clj/orcpub/registration_no_email_test.clj b/test/clj/orcpub/registration_no_email_test.clj new file mode 100644 index 000000000..104bc27bf --- /dev/null +++ b/test/clj/orcpub/registration_no_email_test.clj @@ -0,0 +1,131 @@ +(ns orcpub.registration-no-email-test + "Registration on a deployment with no SMTP configured. + + .env.example offers an empty EMAIL_SERVER_URL as the way to run without email. + Nothing implemented that: the variable was read in exactly one place, as + postal's :host, so leaving it blank did not disable email -- it made every + send FAIL. Registration sends a verification mail, and login refuses an + unverified account (routes.clj:301), so the documented way to turn email off + was also the way to make the site unusable: nobody could register, and any + account that did exist could not log in. + + do-verification now verifies on creation when email is unconfigured. The + operator of a mail-less instance is handing out accounts themselves, so + nobody was proving address ownership either way. + + The decisive test here is the login one. Everything else is bookkeeping; + being able to sign in is the thing that was broken." + (:require + [clojure.test :refer [deftest is testing use-fixtures]] + [datomic.api :as d] + [datomock.core :as dm] + [orcpub.email :as email] + [orcpub.errors :as errors] + [orcpub.routes :as routes] + [orcpub.db.schema :as schema]) + (:import [java.util UUID])) + +(use-fixtures :each + (fn [f] + (binding [errors/*error-prefix* "TEST_ERROR:"] + (f)))) + +(defn- fresh-conn [] + (let [uri (str "datomic:mem:rne-" (UUID/randomUUID))] + (d/create-database uri) + (let [c (dm/fork-conn (d/connect uri))] + @(d/transact c schema/all-schemas) + c))) + +(defn- register-request [conn] + {:conn conn + :db (d/db conn) + :scheme :https + :headers {"host" "example.test"} + :json-params {:username "newcomer" + :email "newcomer@test.com" + :verify-email "newcomer@test.com" + :password "hunter2hunter2" + :send-updates? false}}) + +(defn- find-user [db] + (when-let [e (d/q '[:find ?e . :where [?e :orcpub.user/username "newcomer"]] db)] + (d/pull db '[*] e))) + +(deftest no-smtp-verifies-on-creation + (let [conn (fresh-conn)] + (testing "registration succeeds and the account is already verified" + (with-redefs [email/configured? (constantly false) + email/unverified-registration-allowed? (constantly true) + ;; If this is ever called the test should fail loudly: the + ;; whole point is that no send is attempted. + routes/send-verification-email + (fn [& _] (throw (AssertionError. "tried to send mail with no SMTP configured")))] + (let [resp (routes/register (register-request conn)) + user (find-user (d/db conn))] + (is (= 200 (:status resp))) + (is (true? (get-in resp [:body :verified?])) + "the client branches on this to show \"you can log in\" instead of \"check your email\"") + (is (true? (:orcpub.user/verified? user))) + (is (nil? (:orcpub.user/verification-key user)) + "no key should be stored for a link that is never sent")))))) + +(deftest an-auto-verified-account-can-actually-log-in + ;; The one that matters. login-response refuses an unverified account, so + ;; before this change a mail-less instance produced accounts nobody could use. + (let [conn (fresh-conn)] + (with-redefs [email/configured? (constantly false) + email/unverified-registration-allowed? (constantly true) + routes/send-verification-email (fn [& _] nil)] + (routes/register (register-request conn))) + (testing "the account registered without SMTP can sign in" + (let [resp (routes/login-response + {:conn conn + :db (d/db conn) + :remote-addr "127.0.0.1" + :json-params {:username "newcomer" :password "hunter2hunter2"}})] + (is (= 200 (:status resp)) + (str "Login was refused for an account created on a mail-less " + "instance. Got: " (pr-str (select-keys resp [:status :body])))))))) + +(deftest with-smtp-configured-nothing-changes + (let [conn (fresh-conn) + sent (atom 0)] + (testing "the normal flow still creates an unverified account and mails a link" + (with-redefs [email/configured? (constantly true) + email/unverified-registration-allowed? (constantly false) + routes/send-verification-email (fn [& _] (swap! sent inc) nil)] + (let [resp (routes/register (register-request conn)) + user (find-user (d/db conn))] + (is (= 200 (:status resp))) + (is (nil? (get-in resp [:body :verified?])) + "no :verified? flag, so the client shows \"check your email\"") + (is (false? (:orcpub.user/verified? user))) + (is (some? (:orcpub.user/verification-key user))) + (is (= 1 @sent) "exactly one verification email")))))) + +(deftest losing-smtp-config-fails-closed + ;; The security case. Auto-verify keyed on "no SMTP" ALONE fails open: a + ;; typo'd variable name, a value dropped by a deploy, a failed secrets mount + ;; or a stray space all read as "no email", and a production site silently + ;; stops requiring verification. Measured before this guard: " ", "" and + ;; absent all produced auto-verify. + ;; + ;; Not attacker-triggerable -- environ.core/env is a static map built once at + ;; namespace load, so no request can flip it. The risk is one operator slip + ;; downgrading the site to open registration with no alarm. + (let [conn (fresh-conn)] + (testing "no SMTP and no explicit opt-in refuses to register anyone" + (with-redefs [email/configured? (constantly false) + email/unverified-registration-allowed? (constantly false) + routes/send-verification-email + (fn [& _] (throw (AssertionError. "must not attempt a send")))] + (let [resp (routes/register (register-request conn))] + (is (= 503 (:status resp)) + "registration must be REFUSED when email config is missing and nothing opted out") + ;; A response rather than a throw: a throw reached the client as a bare + ;; 500 and the form showed nothing. The client matches on this key. + (is (= :email-not-configured (get-in resp [:body :error])) + (str "expected a specific, actionable error. Got: " (pr-str resp))) + (is (nil? (find-user (d/db conn))) + "and no account may be created, verified or otherwise")))))) diff --git a/test/clj/orcpub/registration_rollback_test.clj b/test/clj/orcpub/registration_rollback_test.clj new file mode 100644 index 000000000..31a9b3ffa --- /dev/null +++ b/test/clj/orcpub/registration_rollback_test.clj @@ -0,0 +1,212 @@ +(ns orcpub.registration-rollback-test + "Registration must not leave an account behind when the verification email fails. + + do-verification transacts the user and THEN sends the email. Datomic does not + roll back, so a failed send left a committed, unverified account -- and since + register validates against existing username/email, the retry it tells the + user to make then fails with \"already taken\". + + SCOPE, measured rather than assumed. The account is NOT unrecoverable: the + resend-verification route works on exactly this state (verified against the + pre-fix code -- resend returns 200 and stores a fresh key), and it is wired to + a button in the UI. So the real symptom is a confusing dead end that a user + can escape if they find the resend link, not a permanent lockout. An earlier + version of this docstring and of `git show agents/develop:docs/kb/blank-env-values.md` said \"can never + be verified\"; that was wrong. + + Which is why seven years of production never surfaced it: live SMTP works, so + this branch only runs on a transient send failure, and the handful of users it + hits report \"it says my email already exists\" -- indistinguishable from + someone who forgot they had an account. + + It is still worth fixing. A failed send should not leave a half-created + account, and \"please try again\" is the wrong advice when retrying cannot + work. + + The sibling flow already solved this: request-email-change transacts, sends, + and retracts on failure, covered by email_change_test/test-email-send-failure- + rolls-back. These tests are that one's mirror for registration. + + Every test here stubs email/configured? true: these cover the path taken when + a deployment HAS SMTP and the send fails. With it unconfigured, registration + verifies on creation instead and never sends -- that is + registration_no_email_test. + + See `git show agents/develop:docs/kb/blank-env-values.md`." + (:require + [clojure.test :refer [deftest is testing use-fixtures]] + [datomic.api :as d] + [datomock.core :as dm] + [orcpub.email :as email] + [orcpub.errors :as errors] + [orcpub.routes :as routes] + [orcpub.db.schema :as schema]) + (:import [java.util UUID])) + +(use-fixtures :each + (fn [f] + (binding [errors/*error-prefix* "TEST_ERROR:"] + (f)))) + +(defmacro with-conn [conn-binding & body] + `(let [uri# (str "datomic:mem:registration-rollback-test-" (UUID/randomUUID)) + ~conn-binding (do + (d/create-database uri#) + (d/connect uri#))] + (try ~@body + (finally (d/delete-database uri#))))) + +(defn- seed-schema [conn] + @(d/transact conn schema/all-schemas)) + +(defn- find-user [db username] + (when-let [e (d/q '[:find ?e . :in $ ?u :where [?e :orcpub.user/username ?u]] db username)] + (d/pull db '[*] e))) + +(defn- register-request [conn] + {:conn conn + :db (d/db conn) + :scheme :https + :headers {"host" "example.test"} + ;; verify-email is required by registration/validate-registration and must + ;; match :email, or register returns 400 before reaching do-verification. + :json-params {:username "newcomer" + :email "newcomer@test.com" + :verify-email "newcomer@test.com" + :password "hunter2hunter2" + :send-updates? false}}) + +(deftest failed-verification-email-leaves-no-account + (with-conn conn + (let [mocked-conn (dm/fork-conn conn)] + (seed-schema mocked-conn) + (testing "an SMTP failure must not commit a half-created user" + (with-redefs [email/configured? (constantly true) + routes/send-verification-email + (fn [& _] (throw (Exception. "SMTP down")))] + ;; register rethrows; what matters is the DB state afterwards, not + ;; which exception surfaced. + (try (routes/register (register-request mocked-conn)) + (catch Throwable _ nil)) + (let [user (find-user (d/db mocked-conn) "newcomer")] + (is (nil? user) + (str "A failed verification email left an account behind. " + "Retrying registration then fails validation because the " + "username and email are taken -- which is exactly the " + "advice the error message gives. (Recoverable via resend, " + "see the ns docstring, but a dead end from the form.) " + "Found: " (pr-str user))))))))) + +(deftest the-address-can-be-reused-after-a-failed-send + (with-conn conn + (let [mocked-conn (dm/fork-conn conn)] + (seed-schema mocked-conn) + (testing "after a failed send, the same details still validate as available" + (with-redefs [email/configured? (constantly true) + routes/send-verification-email + (fn [& _] (throw (Exception. "SMTP down")))] + (try (routes/register (register-request mocked-conn)) + (catch Throwable _ nil))) + ;; Second attempt, this time with a working mailer. + (with-redefs [email/configured? (constantly true) + routes/send-verification-email (fn [& _] nil)] + (let [resp (routes/register (register-request mocked-conn))] + (is (= 200 (:status resp)) + (str "Retrying after a failed send must succeed -- this is the " + "advice the error message gives the user. Got: " (pr-str resp))) + (let [user (find-user (d/db mocked-conn) "newcomer")] + (is (some? user) "the retry should create the account") + (is (false? (:orcpub.user/verified? user)) + "and it should be awaiting verification")))))))) + +(deftest a-successful-send-still-creates-the-account + (with-conn conn + (let [mocked-conn (dm/fork-conn conn)] + (seed-schema mocked-conn) + (testing "the happy path is unchanged by the rollback" + (with-redefs [email/configured? (constantly true) + routes/send-verification-email (fn [& _] nil)] + (let [resp (routes/register (register-request mocked-conn)) + user (find-user (d/db mocked-conn) "newcomer")] + (is (= 200 (:status resp))) + (is (some? user)) + (is (= "newcomer@test.com" (:orcpub.user/email user))) + (is (false? (:orcpub.user/verified? user))) + (is (some? (:orcpub.user/verification-key user)) + "a verification key must be stored for the emailed link to resolve"))))))) + +(deftest re-verify-rollback-must-not-delete-an-existing-user + ;; The dangerous case. re-verify calls do-verification with an EXISTING + ;; {:db/id id}, so rolling back with :db/retractEntity would delete a real + ;; account -- turning a failed resend into data loss. Only the attributes this + ;; attempt set may be retracted. + (with-conn conn + (let [mocked-conn (dm/fork-conn conn)] + (seed-schema mocked-conn) + (with-redefs [email/configured? (constantly true) + routes/send-verification-email (fn [& _] nil)] + (routes/register (register-request mocked-conn))) + (let [before (find-user (d/db mocked-conn) "newcomer")] + (is (some? before) "precondition: the account exists") + (testing "a failed re-send leaves the account intact" + (with-redefs [email/configured? (constantly true) + routes/send-verification-email + (fn [& _] (throw (Exception. "SMTP down")))] + (try (routes/re-verify {:conn mocked-conn + :db (d/db mocked-conn) + :scheme :https + :headers {"host" "example.test"} + :query-params {:email "newcomer@test.com"}}) + (catch Throwable _ nil))) + (let [after (find-user (d/db mocked-conn) "newcomer")] + (is (some? after) + "THE USER WAS DELETED by a failed verification resend") + (is (= (:orcpub.user/email before) (:orcpub.user/email after))) + (is (= (:orcpub.user/password before) (:orcpub.user/password after)) + "credentials must survive a failed resend") + ;; Not nil: the resend REPLACED the key in the user's inbox before + ;; the send failed. Retracting the new one left the account with no + ;; working link at all, so an email that was still valid stopped + ;; verifying anything. The rollback has to put the old key back. + (is (= (:orcpub.user/verification-key before) + (:orcpub.user/verification-key after)) + "the link already in the user's inbox must still work after a failed resend") + (is (= (:orcpub.user/verification-sent before) + (:orcpub.user/verification-sent after)) + "and its expiry clock must be the original one, not the failed attempt's"))))))) + +(deftest a-failed-resend-must-not-clobber-a-newer-successful-one + ;; Two resends overlap. A writes its key, B writes a newer one and emails it, + ;; then A's send fails. A's rollback must NOT put the original key back over + ;; B's: B's link is the one sitting in the user's inbox. Restore only if the + ;; key is still the one this attempt wrote -- otherwise a newer resend owns it. + (with-conn conn + (let [mocked-conn (dm/fork-conn conn)] + (seed-schema mocked-conn) + (with-redefs [email/configured? (constantly true) + routes/send-verification-email (fn [& _] nil)] + (routes/register (register-request mocked-conn))) + (let [uid (:db/id (find-user (d/db mocked-conn) "newcomer")) + newer-key "key-from-a-concurrent-successful-resend" + newer-sent (java.util.Date.)] + (testing "the newer resend's key survives the older one's rollback" + (with-redefs [email/configured? (constantly true) + routes/send-verification-email + (fn [& _] + ;; Simulate B landing between A's write and A's failure. + @(d/transact mocked-conn + [{:db/id uid + :orcpub.user/verification-key newer-key + :orcpub.user/verification-sent newer-sent}]) + (throw (Exception. "SMTP down")))] + (try (routes/re-verify {:conn mocked-conn + :db (d/db mocked-conn) + :scheme :https + :headers {"host" "example.test"} + :query-params {:email "newcomer@test.com"}}) + (catch Throwable _ nil))) + (let [after (find-user (d/db mocked-conn) "newcomer")] + (is (= newer-key (:orcpub.user/verification-key after)) + "a failed resend overwrote the link a newer resend had already emailed") + (is (= newer-sent (:orcpub.user/verification-sent after)) + "and reset that link's expiry clock to the stale one"))))))) diff --git a/test/clj/orcpub/routes_test.clj b/test/clj/orcpub/routes_test.clj index 843ae5216..7e2697129 100644 --- a/test/clj/orcpub/routes_test.clj +++ b/test/clj/orcpub/routes_test.clj @@ -8,6 +8,7 @@ [buddy.sign.jwt :as jwt] [environ.core :as environ] [orcpub.routes :as routes] + [orcpub.env :as env] [orcpub.dnd.e5.magic-items :as mi] [orcpub.dnd.e5.character :as char5e] [orcpub.modifiers :as mod] @@ -257,7 +258,7 @@ (deftest test-unsubscribe-token-roundtrip (testing "Token encodes email and action, verifiable with signature" (let [token (routes/unsubscribe-token "Test@Example.com") - claims (jwt/unsign token (environ/env :signature))] + claims (jwt/unsign token (env/value :signature))] (is (= "test@example.com" (:email claims)) "Email should be lowercased") (is (= "unsubscribe" (:action claims)))))) diff --git a/test/clj/orcpub/secret_accessors_test.clj b/test/clj/orcpub/secret_accessors_test.clj new file mode 100644 index 000000000..122998b74 --- /dev/null +++ b/test/clj/orcpub/secret_accessors_test.clj @@ -0,0 +1,94 @@ +(ns orcpub.secret-accessors-test + "Two settings can come from a mounted file as well as the environment, and must + only ever be read through the accessor that knows that. + + SIGNATURE -> config/signature (/run/secrets/signature first) + DATOMIC_PASSWORD -> config/datomic-password (/run/secrets/datomic_password first) + + Reading the environment directly still compiles, still passes every other + test, and still works on any deployment that uses environment variables -- + which is why it survived review twice. It breaks only for the deployment that + followed the Docker-secrets instructions in docker-compose.yaml: the secret is + mounted, the variable is deliberately absent, and the direct read returns nil. + In a container there is no .lein-env to mask it, so check-auth returns 500 and + every authenticated call fails with a good secret sitting on disk. + + That is exactly what routes.clj did until 969cf644. orcpub.config already had + the right accessor; the caller reached past it. A correct accessor nobody is + obliged to use is worth nothing -- the lesson this branch learned about + environ.core/env and then repeated one layer up. + + clj-kondo cannot catch this the way it catches bare environ reads: + :discouraged-var matches VARS, and (env/value :signature) is an approved var + with a particular argument. Distinguishing that needs a custom hook, so this + scans the source instead. `lein test` already runs in CI, which is the only + place enforcement matters." + (:require [clojure.test :refer [deftest is testing]] + [clojure.java.io :as io] + [clojure.string :as str])) + +(def ^:private secret-keys + {":signature" "config/signature" + ":datomic-password" "config/datomic-password"}) + +(def ^:private allowed-file + "orcpub/config.clj is where both accessors live, so it reads the keys legitimately." + "config.clj") + +(defn- clj-sources [] + (->> (file-seq (io/file "src")) + (filter #(and (.isFile %) (str/ends-with? (.getName %) ".clj"))) + (remove #(= allowed-file (.getName %))))) + +(defn- offences + "[{:file :line :text :key}] for every direct env read of a secret-backed key. + Comments are skipped: these keys are named in prose all over the codebase, + including in the docstring above." + [] + (for [f (clj-sources) + [n line] (map-indexed vector (str/split-lines (slurp f))) + [k reader] secret-keys + :let [code (str/replace line #";.*$" "")] + :when (re-find (re-pattern (str "\\(env/value\\s+" k "\\b")) code)] + {:file (.getPath f) :line (inc n) :key k :accessor reader :text (str/trim line)})) + +(deftest secrets-are-not-read-straight-from-the-environment + (testing "every secret-backed key goes through its accessor, not env/value" + (let [bad (offences)] + (is (empty? bad) + (str "These read a secret-backed setting directly, so a deployment using " + "Docker secrets gets nil and all authentication fails:\n" + (str/join "\n" + (for [{:keys [file line key] :as o} bad] + (format " %s:%d reads %s — use %s\n %s" + file line key (:accessor o) (:text o))))))))) + +(deftest the-check-can-still-find-something + ;; A scan that cannot match is a scan that passes forever. Prove the pattern + ;; fires on the exact text it exists to reject, without needing a real offence + ;; in the tree. + (testing "the pattern matches a direct read" + (is (re-find #"\(env/value\s+:signature\b" "(def x (env/value :signature))")) + (is (re-find #"\(env/value\s+:datomic-password\b" "(env/value :datomic-password)"))) + + (testing "and does not match the accessor it points people at" + (is (nil? (re-find #"\(env/value\s+:signature\b" "(config/signature)")))) + + (testing "comments are stripped BEFORE matching, not ignored by the pattern" + ;; The pattern matches prose either way. It is the strip in `offences` that + ;; spares it, so that is what gets asserted -- claiming the pattern ignores + ;; comments would be asserting something false. + (let [line ";; never write (env/value :signature) here"] + (is (re-find #"\(env/value\s+:signature\b" line) + "the raw pattern does match, which is why the strip exists") + (is (nil? (re-find #"\(env/value\s+:signature\b" + (str/replace line #";.*$" ""))) + "with the comment removed there is nothing left to match")))) + + +(deftest both-accessors-still-exist + ;; If one is renamed, the message above would name a function nobody can find. + (testing "the accessors this test points people at are real" + (require 'orcpub.config) + (is (some? (resolve 'orcpub.config/signature))) + (is (some? (resolve 'orcpub.config/datomic-password)))))