Resolve security audit findings
ober
0302851f44ea4ac5d92fdc3fb36dd8e19e3932ca
--- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -17,7 +17,7 @@ jobs: build-and-test: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 - name: Install system tools run: | --- a/.github/workflows/security-baseline.yml +++ b/.github/workflows/security-baseline.yml @@ -13,7 +13,7 @@ jobs: baseline: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@34e114876b0b11c390a56381ad16ebd13914f8d5 # v4.3.1 - name: Required release files run: | --- a/.jerboa/security.json +++ b/.jerboa/security.json @@ -14,13 +14,24 @@ "imports": { "directChezscheme": "deny" }, "ffi": { "allowed": false }, "process": { "shellInterpolation": "deny" }, - "network": { "requireTimeouts": true, "rawServiceOutputEvidence": "deny" }, + "network": { + "requireTimeouts": true, + "rawServiceOutputEvidence": "deny", + "credentialTransport": "https-exact-origin-only", + "redirectAuthorization": "deny-cross-origin" + }, "eval": { "stringEval": "deny", "bareRead": "deny", "allowReadEval": false }, "secrets": { "forbidLogging": true, "leastPrivilegeOAuthScopes": true }, "credentials": { "plaintextCache": "deny", "rawCredentialEvidence": "deny", - "preferReadApiScope": true + "preferReadApiScope": true, + "argvSecrets": "deny", + "customOriginTrust": "explicit-exact-match" + }, + "filesystem": { + "config": "canonical-owner-only-no-symlink", + "exports": "descriptor-relative-0700-exclusive-0600-no-follow" }, "targetEvidence": { "gitlabProof": "fail-closed", --- a/.jerbuild +++ b/.jerbuild @@ -8,6 +8,7 @@ (entry "jgl.ss") (output "jgl") (libdirs "lib") +(extra-sources "support/jgl-secure-fs.c") ;; Register the linked-in jerboa-native symbols (regenerated per-platform by ;; the Makefile between the two build passes). (ffi-symbols "support/ffi-symbols.gen") --- a/Makefile +++ b/Makefile @@ -13,6 +13,8 @@ JERBUILD ?= $(shell if [ -x ./jerbuild ]; then echo ./jerbuild; \ JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) NATIVE_DIR = $(JH)/jerboa-native-rs/target/release +JGL_SHIM_DIR := $(CURDIR)/.jerboa/native +JGL_SHIM := $(JGL_SHIM_DIR)/$(if $(filter Darwin,$(shell uname -s)),libjgl_secure_fs.dylib,libjgl_secure_fs.so) LIBDIRS = --libdirs lib:$(JH)/lib JEXEC = "$(JERBUILD)" exec $(LIBDIRS) BIN := jgl @@ -22,7 +24,7 @@ RELEASE_EVIDENCE_DIR ?= $(DIST_DIR)/release-evidence TARGET_EVIDENCE_DIR ?= $(DIST_DIR)/target-evidence # The std net modules dlopen libjerboa_native in interpreter mode; point the # loader at jerbuild's cache for `make run`/`make test`. -DYLD := DYLD_FALLBACK_LIBRARY_PATH="$(NATIVE_DIR)" LD_LIBRARY_PATH="$(NATIVE_DIR):$$LD_LIBRARY_PATH" +DYLD := JGL_DEV_NATIVE=1 JGL_SECURE_FS_LIB="$(JGL_SHIM)" DYLD_FALLBACK_LIBRARY_PATH="$(NATIVE_DIR)" LD_LIBRARY_PATH="$(NATIVE_DIR):$$LD_LIBRARY_PATH" # --- Cross-compilation (macOS -> Linux x86_64 musl) --- # jgl's HTTPS uses rustls (jerboa-native), so the cross build links a musl-cross @@ -38,7 +40,7 @@ MUSL_TARGET := x86_64-unknown-linux-musl MUSL_CC ?= x86_64-linux-musl-gcc NATIVE_MUSL_A := $(JH)/jerboa-native-rs/target/$(MUSL_TARGET)/release/libjerboa_native.a -.PHONY: all build binary run test native-runtime security verify sbom reproducibility-report target-evidence target-evidence-selftest release-evidence install clean help cross-linux ensure-jerboa-tools +.PHONY: all build binary run test native-runtime jgl-secure-fs-shim security verify sbom reproducibility-report target-evidence target-evidence-selftest release-evidence install clean help cross-linux ensure-jerboa-tools .DEFAULT_GOAL := help all: binary @@ -63,6 +65,13 @@ native-runtime: ensure-jerboa-tools @command -v cargo >/dev/null 2>&1 || { echo "ERROR: cargo not found on PATH."; exit 1; } cargo build --release --manifest-path "$(JH)/jerboa-native-rs/Cargo.toml" --no-default-features --features tls,crypto +jgl-secure-fs-shim: + @mkdir -p "$(JGL_SHIM_DIR)" + @case "$$(uname -s)" in \ + Darwin) $(CC) -dynamiclib -fPIC -O2 -Wall -Wextra -Werror -I support -o "$(JGL_SHIM)" support/jgl-secure-fs.c ;; \ + *) $(CC) -shared -fPIC -O2 -Wall -Wextra -Werror -I support -o "$(JGL_SHIM)" support/jgl-secure-fs.c ;; \ + esac + # Standalone native binary via .jerbuild (entry jgl.ss -> jgl). # Two passes: pass 1 cargo-builds jerboa-native into jerbuild's cache; we then # regenerate the FFI symbol list (platform-correct) and relink. @@ -77,19 +86,12 @@ build: binary run: binary $(DYLD) ./$(BIN) $(ARGS) -test: native-runtime +test: native-runtime jgl-secure-fs-shim $(DYLD) $(JEXEC) test/test-jgl.ss + $(DYLD) $(JEXEC) test/test-secure-fs.ss security: - @set -eu; \ - pattern="(BEGIN (RSA|OPENSSH|EC|DSA|PRIVATE) KEY|ghp_[A-Za-z0-9_]{20,}|github_pat_[A-Za-z0-9_]{20,}|glpat-[A-Za-z0-9_-]{20,}|gldt-[A-Za-z0-9_-]{20,}|glrt-[A-Za-z0-9_-]{20,}|AKIA[0-9A-Z]{16}|ASIA[0-9A-Z]{16})"; \ - matches="$$(git grep -n -I -E "$$pattern" -- . ":!*.png" ":!*.jpg" ":!*.jpeg" ":!*.gif" ":!*.so" ":!*.dylib" ":!*.o" ":!*.a" ":!*.boot" ":!*.tar.gz" || true)"; \ - if [ -n "$$matches" ]; then \ - echo "$$matches"; \ - echo "High-confidence secret pattern found."; \ - exit 1; \ - fi; \ - echo "secret_scan_status=pass" + @sh scripts/security-check.sh sbom: ensure-jerboa-tools @REPO_ROOT="$(CURDIR)" \ @@ -179,6 +181,7 @@ clean: rm -f $(BIN) jgl-linux-amd64 jgl-*main.c *.h *.boot *.wp.so find . \( -name '*.so' -o -name '*.wpo' -o -name '*.tarm64osx' -o -name '*.ta6le' \) -delete 2>/dev/null || true rm -rf dist + rm -rf "$(JGL_SHIM_DIR)" help: @echo "jerboa-gitlab -- the jgl GitLab CLI (jerbuild + cargo + cc)" --- a/README.md +++ b/README.md @@ -53,7 +53,9 @@ jgl <command> [options] | Option | Description | |-------------------|----------------------------------------------------------| | `--url URL` | GitLab base URL (env `GITLAB_URL`, default `https://gitlab.com`) | -| `--token TOKEN` | Access token (env `GITLAB_TOKEN`); optional for public projects | +| `--token-fd FD` | Read an access token from a dedicated descriptor (`GITLAB_TOKEN` also supported) | +| `--trusted-origin O` | Required exact trust assertion for authenticated custom GitLab origins | +| `--allow-insecure-loopback` | Permit HTTP only for literal `127.0.0.1` development | | `-p, --project P` | Project ID or path, e.g. `123` or `group/proj` (env `GITLAB_PROJECT`) | | `-f, --format FMT`| `text` (default) or `json` | | `--state STATE` | issues: `opened` \| `closed` \| `all` (default `all`) | @@ -73,8 +75,9 @@ read without one. ## Security `jgl` can read private GitLab project metadata, issues, comments, CI status, and -attachments. Prefer a `read_api` token, avoid passing tokens in argv on shared -systems, and treat `jgl export` output as sensitive. Credential and export +attachments. Prefer a `read_api` token; token arguments are rejected, so use a +secret-manager environment injection, a dedicated descriptor, or an owner-only +config. Treat `jgl export` output as sensitive. Credential and export handling are documented in [`docs/credential-handling.md`](docs/credential-handling.md). Native dependency provenance is documented in [`docs/dependency-provenance.md`](docs/dependency-provenance.md), and local @@ -101,6 +104,12 @@ project: group/project format: text ``` +An existing config must be a canonical, non-symlink, owner-only regular file +(normally mode `0600`). Authenticated custom instances must also set an exact +`trusted_origin`, for example `https://gitlab.example:443`. URLs use HTTPS; +plaintext HTTP is available only with `--allow-insecure-loopback` for literal +`127.0.0.1` development. + ### Examples ```sh @@ -137,7 +146,11 @@ as a path (`group/proj`), referenced `/uploads/` attachments are downloaded into `attachments/` and the links are rewritten to point at the local copies; if a download fails the original link is left intact. Issue directory names and attachment filenames derived from API responses are sanitized before local -filesystem writes. +filesystem writes. Export directories are descriptor-walked without following +symlinks, created mode `0700`, and files are created exclusively at mode `0600`; +an existing destination is never overwritten. Human-readable terminal output +escapes control/bidirectional characters. JSON and markdown exports remain +lossless representations of the project content. ## Cross-compilation @@ -171,11 +184,13 @@ wired up yet.) jgl.ss entry point (argv via env or command line) lib/jgl/client.ss HTTPS + JSON + pagination + percent-encoding lib/jgl/config.ss resolve url/token/project from flags + env +lib/jgl/secure-fs.ss owner/mode checks + descriptor-relative exports lib/jgl/format.ss field access, JSON re-serialization, formatters lib/jgl/issues.ss issue list/get/notes + markdown export lib/jgl/ci.ss pipelines / jobs / latest status lib/jgl/cli.ss argument parsing, dispatch, rendering -test/test-jgl.ss unit tests (pure logic) +test/test-jgl.ss policy/format/path unit tests +test/test-secure-fs.ss no-follow/private/exclusive filesystem tests ``` ## License --- a/SECURITY.md +++ b/SECURITY.md @@ -14,12 +14,20 @@ experimental until the release checklist in `~/Release-plan.md` and - Use the narrowest GitLab token scope possible. `read_api` is expected for private read-only project usage. -- Prefer `GITLAB_TOKEN` from a secret manager or a mode-0600 config file over - passing tokens in argv. +- Token argv is rejected. Prefer a dedicated `--token-fd`, secret-manager + environment injection, or a validated owner-only config file. +- Require HTTPS and exact canonical origin trust for authenticated custom + instances. HTTP is limited to an explicit literal-loopback development mode; + authorization is never forwarded cross-origin or through redirects. - Do not commit `~/.gitlab.yaml`, GitLab tokens, exported issue archives, downloaded attachments, private project paths, or private hostnames. -- Treat `jgl export` output as sensitive. It may contain issue bodies, comments, - labels, usernames, project URLs, and attachments. +- Treat `jgl export` output as sensitive. Descriptor-relative no-follow walks, + `0700` directories, and exclusive `0600` files prevent symlink overwrite and + ambient-permission disclosure, but the plaintext content remains sensitive. +- Text terminal rendering neutralizes control/bidirectional sequences; use JSON + or the private export path for lossless automation/content retention. +- Cross binaries retain memfd execution where available and otherwise use an + exclusive file inside a private unpredictable directory, keeping its fd open. - Keep raw GitLab API response bodies out of logs and errors. Runtime errors redact response bodies and strip query strings from failed API paths. - Production release requires marker-complete live GitLab target evidence --- a/build-jgl-cross.ss +++ b/build-jgl-cross.ss @@ -102,7 +102,10 @@ "pipe" "dup" "dup2" "lseek" "setenv" "unsetenv" "strerror" "localtime" "strftime" "sysconf" "getpagesize" "getrlimit" "system" "getenv" "putenv" "_exit" "exit" "execvp" "execve" "mkstemp" "mkdtemp" "unlink" "rmdir" - "__errno_location" "fcntl")) + "__errno_location" "fcntl" + "jgl_open" "jgl_openat" "jgl_close" "jgl_fsync" "jgl_fchmod" + "jgl_fstat" "jgl_realpath" "jgl_geteuid" "jgl_mkdirat" "jgl_unlinkat" + "jgl_errno_value")) (printf "==> build-jgl-cross (rustls/musl)~n") (printf " cross csv-dir: ~a~n native .a: ~a~n symbols: ~a jerboa_* + ~a libc~n output: ~a~n~n" @@ -196,9 +199,11 @@ (for-each (lambda (h) (display (format "#include <~a>\n" h) out)) '("stdlib.h" "string.h" "stdio.h" "unistd.h" "sys/mman.h" "sys/types.h" "sys/stat.h" "sys/wait.h" "sys/resource.h" "sys/socket.h" "netinet/in.h" - "arpa/inet.h" "netdb.h" "termios.h" "fcntl.h" "signal.h" "time.h" "errno.h")) + "arpa/inet.h" "netdb.h" "termios.h" "fcntl.h" "signal.h" "time.h" "errno.h" + "limits.h")) (display "#include \"scheme.h\"\n#include \"petite_boot.h\"\n" out) (display "#include \"scheme_boot.h\"\n#include \"jgl_program.h\"\n\n" out) + (display "#include \"support/jgl-secure-fs.h\"\n\n" out) ;; dlopen stubs: succeed only for the main exe (NULL/"") so the Scheme ;; (load-shared-object "libfoo") guard falls back to registered symbols. @@ -207,6 +212,10 @@ (display "int dlclose(void *h){ (void)h; return 0; }\n" out) (display "static char dlerr[]=\"static binary: dlopen of named libraries is stubbed\";\n" out) (display "char *dlerror(void){ return dlerr; }\n\n" out) + (display "static int write_full(int fd, const unsigned char *buf, size_t len) {\n" out) + (display " size_t off = 0; while (off < len) { ssize_t n = write(fd, buf + off, len - off);\n" out) + (display " if (n > 0) { off += (size_t)n; continue; }\n" out) + (display " if (n < 0 && errno == EINTR) continue; return -1; } return 0;\n}\n\n" out) (display "/* libjerboa_native.a (rustls/crypto) exports. */\n" out) (for-each (lambda (s) (display (format "extern void ~a();\n" s) out)) jerboa-symbols) @@ -222,25 +231,33 @@ (display "int main(int argc, char *argv[]) {\n" out) (display " setenv(\"JERBOA_STATIC\", \"1\", 1);\n" out) (display " int fd = memfd_create(\"jgl-program\", MFD_CLOEXEC);\n" out) - (display " char prog_path[64];\n" out) + (display " int private_dir_used = 0;\n" out) + (display " char private_dir[PATH_MAX] = {0};\n" out) + (display " char prog_path[PATH_MAX] = {0};\n" out) (display " if (fd >= 0) {\n" out) - (display " if (write(fd, jgl_program, jgl_program_size) != (ssize_t)jgl_program_size) {\n" out) + (display " if (write_full(fd, jgl_program, jgl_program_size) < 0 || fsync(fd) < 0 || lseek(fd, 0, SEEK_SET) < 0) {\n" out) (display " perror(\"write memfd\"); close(fd); return 1; }\n" out) - (display " snprintf(prog_path, sizeof(prog_path), \"/proc/self/fd/%d\", fd);\n" out) + (display " if (snprintf(prog_path, sizeof(prog_path), \"/proc/self/fd/%d\", fd) >= (int)sizeof(prog_path)) { close(fd); return 1; }\n" out) (display " } else {\n" out) (display " const char *tmp = getenv(\"TMPDIR\"); if (!tmp) tmp = \"/tmp\";\n" out) - (display " snprintf(prog_path, sizeof(prog_path), \"%s/.jgl-prog-%d.so\", tmp, getpid());\n" out) - (display " FILE *fp = fopen(prog_path, \"wb\"); if (!fp) { perror(\"fopen\"); return 1; }\n" out) - (display " if (fwrite(jgl_program, 1, jgl_program_size, fp) != jgl_program_size) {\n" out) - (display " perror(\"fwrite\"); fclose(fp); unlink(prog_path); return 1; }\n" out) - (display " fclose(fp);\n }\n" out) + (display " if (tmp[0] != '/' || snprintf(private_dir, sizeof(private_dir), \"%s/.jgl-prog.XXXXXX\", tmp) >= (int)sizeof(private_dir)) return 1;\n" out) + (display " if (!mkdtemp(private_dir)) { perror(\"mkdtemp\"); return 1; }\n" out) + (display " private_dir_used = 1; if (chmod(private_dir, 0700) < 0) { perror(\"chmod\"); rmdir(private_dir); return 1; }\n" out) + (display " struct stat ds; if (lstat(private_dir, &ds) < 0 || !S_ISDIR(ds.st_mode) || ds.st_uid != geteuid() || (ds.st_mode & 0777) != 0700) { rmdir(private_dir); return 1; }\n" out) + (display " if (snprintf(prog_path, sizeof(prog_path), \"%s/program.so\", private_dir) >= (int)sizeof(prog_path)) { rmdir(private_dir); return 1; }\n" out) + (display " fd = open(prog_path, O_WRONLY|O_CREAT|O_EXCL|O_NOFOLLOW|O_CLOEXEC, 0600);\n" out) + (display " if (fd < 0) { perror(\"open\"); rmdir(private_dir); return 1; }\n" out) + (display " struct stat fs; if (fchmod(fd, 0600) < 0 || fstat(fd, &fs) < 0 || !S_ISREG(fs.st_mode) || fs.st_uid != geteuid() || fs.st_nlink != 1 || (fs.st_mode & 0777) != 0600 || write_full(fd, jgl_program, jgl_program_size) < 0 || fsync(fd) < 0 || lseek(fd, 0, SEEK_SET) < 0) {\n" out) + (display " perror(\"secure program write\"); close(fd); unlink(prog_path); rmdir(private_dir); return 1; }\n" out) + (display " }\n" out) (display " Sscheme_init(NULL);\n" out) (display " Sregister_boot_file_bytes(\"petite\", (void*)petite_boot, petite_boot_size);\n" out) (display " Sregister_boot_file_bytes(\"scheme\", (void*)scheme_boot, scheme_boot_size);\n" out) (display " Sbuild_heap(NULL, NULL);\n" out) (display " register_ffi_symbols();\n" out) (display " int status = Sscheme_program(prog_path, argc, (const char **)argv);\n" out) - (display " if (fd >= 0) close(fd); else unlink(prog_path);\n" out) + (display " if (fd >= 0) close(fd);\n" out) + (display " if (private_dir_used) { unlink(prog_path); rmdir(private_dir); }\n" out) (display " Sscheme_deinit();\n return status;\n}\n" out))) ;; ── Stage 6: compile + link with cross-cc ────────────────────────────────── @@ -250,6 +267,7 @@ (shell-quote cross-cc) " -static -O2 -I " (shell-quote cross-csv-dir) " " (shell-quote main-c-path) + " " (shell-quote (format "~a/support/jgl-secure-fs.c" jgl-repo)) " -Wl,--start-group " (shell-quote native-a) " " (shell-quote (format "~a/libkernel.a" cross-csv-dir)) " " --- a/docs/credential-handling.md +++ b/docs/credential-handling.md @@ -8,7 +8,7 @@ known public. `jgl` resolves credentials in this order: -1. `--token TOKEN` +1. `--token-fd FD` (a dedicated descriptor supplied by a secret manager) 2. `GITLAB_TOKEN` 3. `token:` in `~/.gitlab.yaml` or the path supplied by `--config` or `GITLAB_CONFIG` @@ -19,16 +19,31 @@ sudo-capable tokens for routine issue and CI queries. ## Local Storage -`jgl` does not persist tokens by itself. If a config file stores a token, the -operator is responsible for filesystem permissions. Recommended mode: +`--token TOKEN` is deliberately rejected because argv is visible in process +listings, diagnostics, and shell history. `jgl` does not persist tokens by +itself. A present config is accepted only when it is a canonical, non-symlink, +single-link regular file owned by the effective user with no group/other access. +Use: ```sh chmod 0600 ~/.gitlab.yaml ``` -Avoid passing tokens on a shared shell command line because process listings and -shell history can expose argv. Prefer `GITLAB_TOKEN` from a secret manager or a -mode-0600 config file. +Prefer descriptor injection when the secret manager supports it; environment +injection is retained for common CI systems. + +## Origin And Transport Policy + +All GitLab base URLs must be syntactically valid HTTPS URLs without userinfo, +query strings, fragments, dot segments, or control characters. `gitlab.com` is +the sole built-in authenticated origin. A custom instance carrying a token must +have an exact `--trusted-origin`, `GITLAB_TRUSTED_ORIGIN`, or `trusted_origin:` +config assertion. Attachment authorization is sent only to that same canonical +scheme/host/port; redirects are not followed. + +Plain HTTP is rejected except for explicit literal `127.0.0.1` development with +`--allow-insecure-loopback`. This exception does not trust `localhost`, +lookalike hostnames, or other numeric addresses. ## Error Output @@ -43,7 +58,11 @@ response byte count. Failed API paths are reported without query strings. usernames, labels, private project URLs, and binary attachments. Store exports outside public repos unless intentionally publishing sanitized project data. Issue directory names and downloaded attachment filenames derived from API -responses are sanitized before local filesystem writes. +responses are sanitized before local filesystem writes. Every component is +walked relative to held directory descriptors with no-follow semantics. New +directories are `0700`, new files are exclusive `0600`, data is fsynced, and +existing paths are not replaced. Text rendered to a terminal escapes ANSI/OSC, +control, and bidirectional formatting characters; JSON escapes them losslessly. ## Release Requirements --- a/lib/jgl/cli.ss +++ b/lib/jgl/cli.ss @@ -28,7 +28,8 @@ (def (value-flag-key name) (cond [(member name '("--url")) "url"] - [(member name '("--token")) "token"] + [(member name '("--token-fd")) "token-fd"] + [(member name '("--trusted-origin")) "trusted-origin"] [(member name '("--project" "-p")) "project"] [(member name '("--format" "-f")) "format"] [(member name '("--state")) "state"] @@ -53,14 +54,17 @@ (loop (cdr a) pos (cons (cons "help" "1") opts))] [(member (car a) '("--version")) (loop (cdr a) pos (cons (cons "version" "1") opts))] + [(string=? (car a) "--allow-insecure-loopback") + (loop (cdr a) pos (cons (cons "allow-insecure-loopback" "1") opts))] + [(string=? (car a) "--token") + (error 'jgl "--token is forbidden because process arguments are public; use GITLAB_TOKEN, --token-fd, or an owner-only config")] [(value-flag-key (car a)) => (lambda (key) (if (pair? (cdr a)) (loop (cddr a) pos (cons (cons key (cadr a)) opts)) - (loop (cdr a) pos opts)))] - [(string-prefix? (car a) "-") - ;; Unknown flag: ignore (keeps parsing forgiving). - (loop (cdr a) pos opts)] + (error 'jgl (string-append "missing value for " (car a)))))] + [(string-prefix? "-" (car a)) + (error 'jgl (string-append "unknown option: " (car a)))] [else (loop (cdr a) (cons (car a) pos) opts)]))) @@ -81,6 +85,7 @@ ;; --- Rendering --- (def (json-out v) (displayln (json->string v))) + (def (ts value) (terminal-safe-inline value)) (def (render-issues issues fmt) (if (string=? fmt "json") @@ -88,18 +93,18 @@ (begin (for-each (lambda (i) - (displayln "#" (pad-right (jstr i "iid") 5) " " - (pad-right (string-append "[" (jstr i "state") "]") 10) " " - (jstr i "title") + (displayln "#" (pad-right (ts (jstr i "iid")) 5) " " + (pad-right (string-append "[" (ts (jstr i "state")) "]") 10) " " + (ts (jstr i "title")) (let ([l (labels->string (jref i "labels"))]) - (if (string=? l "") "" (string-append " {" l "}"))))) + (if (string=? l "") "" (string-append " {" (ts l) "}"))))) issues) (displayln (number->string (length issues)) " issue(s)")))) (def (render-issue issue notes fmt) (if (string=? fmt "json") (json-out issue) - (display (issue->markdown issue notes)))) + (display (terminal-safe-block (issue->markdown issue notes))))) (def (render-pipelines pipelines fmt) (if (string=? fmt "json") @@ -107,11 +112,11 @@ (if (and (list? pipelines) (pair? pipelines)) (for-each (lambda (p) - (displayln "#" (pad-right (jint p "id") 8) " " - (pad-right (jstr p "status") 10) " " - (pad-right (jstr p "ref") 20) " " - (truncate-str (jstr p "sha") 8) " " - (short-date (jstr p "created_at")))) + (displayln "#" (pad-right (ts (jint p "id")) 8) " " + (pad-right (ts (jstr p "status")) 10) " " + (pad-right (ts (jstr p "ref")) 20) " " + (truncate-str (ts (jstr p "sha")) 8) " " + (ts (short-date (jstr p "created_at"))))) pipelines) (displayln "No pipelines found.")))) @@ -121,10 +126,11 @@ (if (and (list? jobs) (pair? jobs)) (for-each (lambda (j) - (displayln "#" (pad-right (jint j "id") 8) " " - (pad-right (jstr j "status") 10) " " - (pad-right (string-append (jstr j "stage") "/" (jstr j "name")) 28) " " - (jstr j "ref"))) + (displayln "#" (pad-right (ts (jint j "id")) 8) " " + (pad-right (ts (jstr j "status")) 10) " " + (pad-right (string-append (ts (jstr j "stage")) "/" + (ts (jstr j "name"))) 28) " " + (ts (jstr j "ref")))) jobs) (displayln "No jobs found.")))) @@ -132,18 +138,18 @@ (if (string=? fmt "json") (json-out pipeline) (begin - (displayln "Pipeline #" (jint pipeline "id") " " (jstr pipeline "status")) - (displayln " ref: " (jstr pipeline "ref")) - (displayln " sha: " (jstr pipeline "sha")) - (displayln " created: " (short-date (jstr pipeline "created_at"))) - (displayln " url: " (jstr pipeline "web_url")) + (displayln "Pipeline #" (ts (jint pipeline "id")) " " (ts (jstr pipeline "status"))) + (displayln " ref: " (ts (jstr pipeline "ref"))) + (displayln " sha: " (ts (jstr pipeline "sha"))) + (displayln " created: " (ts (short-date (jstr pipeline "created_at")))) + (displayln " url: " (ts (jstr pipeline "web_url"))) (displayln " jobs:") (if (and (list? jobs) (pair? jobs)) (for-each (lambda (j) - (displayln " #" (pad-right (jint j "id") 8) " " - (pad-right (jstr j "status") 10) " " - (jstr j "stage") "/" (jstr j "name"))) + (displayln " #" (pad-right (ts (jint j "id")) 8) " " + (pad-right (ts (jstr j "status")) 10) " " + (ts (jstr j "stage")) "/" (ts (jstr j "name")))) jobs) (displayln " (none)"))))) @@ -151,17 +157,18 @@ (if (string=? fmt "json") (json-out p) (begin - (displayln (jstr p "path_with_namespace") " (id " (jint p "id") ")") - (let ([d (jstr p "description")]) (when (not (string=? d "")) (displayln " " d))) - (displayln " default branch: " (jstr p "default_branch")) - (displayln " url: " (jstr p "web_url"))))) + (displayln (ts (jstr p "path_with_namespace")) " (id " (ts (jint p "id")) ")") + (let ([d (jstr p "description")]) + (when (not (string=? d "")) (displayln " " (ts d)))) + (displayln " default branch: " (ts (jstr p "default_branch"))) + (displayln " url: " (ts (jstr p "web_url")))))) (def (render-ci-status pipeline fmt) (if (string=? fmt "json") (json-out (or pipeline '())) (if pipeline - (displayln (jstr pipeline "status") " pipeline #" (jint pipeline "id") - " (" (jstr pipeline "ref") ") " (jstr pipeline "web_url")) + (displayln (ts (jstr pipeline "status")) " pipeline #" (ts (jint pipeline "id")) + " (" (ts (jstr pipeline "ref")) ") " (ts (jstr pipeline "web_url"))) (displayln "No pipelines found.")))) ;; --- Help / version --- @@ -186,7 +193,9 @@ Commands: Options: --url URL GitLab base URL [env GITLAB_URL, default https://gitlab.com] - --token TOKEN Access token [env GITLAB_TOKEN] + --token-fd FD Read access token from a dedicated descriptor + --trusted-origin O Explicitly trust this exact custom HTTPS origin + --allow-insecure-loopback Permit HTTP only for literal 127.0.0.1 development -p, --project P Project ID or path [env GITLAB_PROJECT] -f, --format FMT text | json (default text) --state STATE issues: opened|closed|all (default all) @@ -201,11 +210,11 @@ Options: --version Show version Config: flags override env vars override ~/.gitlab.yaml (keys: url, token, -project, format) override defaults. +project, format, trusted_origin, allow_insecure_loopback) override defaults. Examples: jgl issues -p group/proj --state opened - jgl issue 42 -p 123 --token glpat-xxxx + GITLAB_TOKEN=... jgl issue 42 -p 123 jgl pipelines -p group/proj --ref main jgl ci-status -p group/proj --ref main jgl export -p group/proj -o ./archive @@ -243,9 +252,9 @@ Examples: ["export" (require-conn o) (let ([outdir (or (opt opts "output") "issues")]) - (displayln "Exporting issues from " project " to " outdir "/ ...") + (displayln "Exporting issues from " (ts project) " to " (ts outdir) "/ ...") (let ([n (export-issues c project outdir)]) - (displayln "Done: " (number->string n) " issue(s) -> " outdir "/")))] + (displayln "Done: " (number->string n) " issue(s) -> " (ts outdir) "/")))] [(or "pipelines" "pipeline-list") (require-conn o) @@ -292,20 +301,26 @@ Examples: ;; --- Entry --- (def (main argv) - (let* ([parsed (parse-args argv)] - [command (car parsed)] - [positionals (cadr parsed)] - [opts (caddr parsed)]) - (cond - [(opt opts "version") (print-version) (exit 0)] - [(or (opt opts "help") (not command)) (print-help) (exit 0)] - [else - (guard (e (#t (displayln "jgl: error: " (err-string e)) (exit 1))) - (let* ([o (resolve-opts (opt opts "url") (opt opts "token") + (guard (e (#t + (displayln "jgl: error: " (terminal-safe-block (err-string e))) + (exit 1))) + (let* ([parsed (parse-args argv)] + [command (car parsed)] + [positionals (cadr parsed)] + [opts (caddr parsed)]) + (cond + [(opt opts "version") (print-version) (exit 0)] + [(or (opt opts "help") (not command)) (print-help) (exit 0)] + [else + (let* ([token (and (opt opts "token-fd") + (read-token-from-fd (opt opts "token-fd")))] + [o (resolve-opts (opt opts "url") token (opt opts "project") (opt opts "format") - (opt opts "config"))] + (opt opts "config") + (opt opts "trusted-origin") + (and (opt opts "allow-insecure-loopback") #t))] [c (opts->client o)]) (dispatch command positionals opts o c)) - (exit 0))]))) + (exit 0)])))) ) ;; end library --- a/lib/jgl/client.ss +++ b/lib/jgl/client.ss @@ -6,9 +6,11 @@ ;;; binary download for attachments. (library (jgl client) - (export make-client client? client-base-url client-token - gl-get gl-get-all gl-get-text gl-try-get gl-download - pct-encode build-query api-path gitlab-error-response-summary) + (export make-client client? client-base-url client-token client-origin + gl-get gl-get-all gl-get-text gl-try-get gl-download gl-download-at + pct-encode build-query api-path gitlab-error-response-summary + gitlab-normalize-base-url gitlab-canonical-origin + gitlab-same-origin? gitlab-loopback-origin?) (import (except (chezscheme) make-hash-table hash-table? sort sort! @@ -20,12 +22,153 @@ make-date make-time) (except (jerboa prelude) meta atom?) (std net request) + (std net uri) (std text json) - (std misc string)) + (std misc string) + (jgl secure-fs)) - ;; A client is just a base URL ("https://gitlab.com", no trailing slash) - ;; plus a personal access token. - (defstruct client (base-url token)) + (defstruct jgl-client (base-url token origin allow-insecure-loopback?)) + (def client? jgl-client?) + (def client-base-url jgl-client-base-url) + (def client-token jgl-client-token) + (def client-origin jgl-client-origin) + + (def (ascii-alpha? ch) + (or (char<=? #\a ch #\z) (char<=? #\A ch #\Z))) + + (def (ascii-digit? ch) (char<=? #\0 ch #\9)) + + (def (valid-host? host) + (and (string? host) (> (string-length host) 0) + (not (char=? (string-ref host 0) #\.)) + (not (char=? (string-ref host (- (string-length host) 1)) #\.)) + (let loop ([i 0]) + (cond [(= i (string-length host)) #t] + [(let ([ch (string-ref host i)]) + (or (ascii-alpha? ch) (ascii-digit? ch) + (char=? ch #\.) (char=? ch #\-))) + (loop (+ i 1))] + [else #f])))) + + (def (string-has-forbidden-url-char? value) + (let loop ([i 0]) + (cond [(= i (string-length value)) #f] + [(let ([n (char->integer (string-ref value i))]) + (or (< n 33) (= n 127) (char=? (string-ref value i) #\\))) #t] + [else (loop (+ i 1))]))) + + (def (path-has-dot-segment? path) + (let loop ([i 0] [start 0]) + (cond + [(= i (string-length path)) + (let ([part (substring path start i)]) + (or (string=? part ".") (string=? part "..")))] + [(char=? (string-ref path i) #\/) + (let ([part (substring path start i)]) + (or (string=? part ".") (string=? part "..") + (loop (+ i 1) (+ i 1))))] + [else (loop (+ i 1) start)]))) + + (def (strip-trailing-slashes path) + (let loop ([n (string-length path)]) + (if (and (> n 0) (char=? (string-ref path (- n 1)) #\/)) + (loop (- n 1)) + (substring path 0 n)))) + + (def (gitlab-loopback-origin? scheme host) + (and (string=? scheme "http") + (string=? host "127.0.0.1"))) + + (def (authority-has-port-delimiter? url scheme) + (let ([start (+ (string-length scheme) 3)]) + (let loop ([i start]) + (cond [(>= i (string-length url)) #f] + [(memv (string-ref url i) '(#\/ #\? #\#)) #f] + [(char=? (string-ref url i) #\:) #t] + [else (loop (+ i 1))])))) + + ;; Returns (base-url origin-key), where origin-key always includes the port. + (def (validated-base-url url allow-insecure-loopback?) + (unless (and (string? url) (> (string-length url) 0) + (not (string-has-forbidden-url-char? url))) + (error 'jgl-url "GitLab URL is empty or contains forbidden characters")) + (let* ([parsed (uri-parse url)] + [scheme (and (uri-scheme parsed) (string-downcase (uri-scheme parsed)))] + [host (and (uri-host parsed) (string-downcase (uri-host parsed)))] + [raw-port (uri-port parsed)] + [explicit-port? (and scheme (authority-has-port-delimiter? url scheme))] + [port (or raw-port + (and scheme (not explicit-port?) + (if (string=? scheme "https") 443 80)))] + [raw-path (or (uri-path parsed) "")] + [path (strip-trailing-slashes raw-path)]) + (unless (and scheme host (valid-host? host) + (integer? port) (exact? port) (> port 0) (<= port 65535) + (not (uri-userinfo parsed)) + (not (uri-query parsed)) + (not (uri-fragment parsed)) + (or (string=? raw-path "") + (char=? (string-ref raw-path 0) #\/)) + (not (path-has-dot-segment? raw-path))) + (error 'jgl-url "GitLab URL must be a valid credential-free origin/base path" url)) + (unless (or (string=? scheme "https") + (and allow-insecure-loopback? + (gitlab-loopback-origin? scheme host))) + (error 'jgl-url + "GitLab URL must use HTTPS; HTTP is limited to explicit loopback development" + url)) + (let* ([default-port (if (string=? scheme "https") 443 80)] + [display-origin + (string-append scheme "://" host + (if (= port default-port) + "" + (string-append ":" (number->string port))))] + [origin-key + (string-append scheme "://" host ":" (number->string port))]) + (list (string-append display-origin path) origin-key)))) + + (def (gitlab-normalize-base-url url allow-insecure-loopback?) + (car (validated-base-url url allow-insecure-loopback?))) + + (def (gitlab-canonical-origin url allow-insecure-loopback?) + (cadr (validated-base-url url allow-insecure-loopback?))) + + (def (gitlab-same-origin? c url) + (guard (_ [#t #f]) + (string=? (client-origin c) + (gitlab-canonical-origin + url (jgl-client-allow-insecure-loopback? c))))) + + (def (valid-token? token) + (and (string? token) (<= (string-length token) 4096) + (let loop ([i 0]) + (cond [(= i (string-length token)) #t] + [(let ([n (char->integer (string-ref token i))]) + (or (< n 33) (= n 127))) #f] + [else (loop (+ i 1))])))) + + ;; Custom authenticated GitLab instances require an explicit trusted-origin + ;; assertion. The public gitlab.com origin is the only built-in trust anchor. + (def (make-client base-url token . policy) + (let* ([trusted-origin (if (pair? policy) (car policy) #f)] + [allow-insecure? (and (pair? policy) (pair? (cdr policy)) + (cadr policy))] + [validated (validated-base-url base-url allow-insecure?)] + [normalized (car validated)] + [origin (cadr validated)] + [token (if (string? token) token "")] + [trusted-key + (and (string? trusted-origin) (not (string=? trusted-origin "")) + (gitlab-canonical-origin trusted-origin allow-insecure?))]) + (unless (or (string=? token "") (valid-token? token)) + (error 'jgl-token "token must be a bounded non-whitespace string")) + (when (and (not (string=? token "")) + (not (string=? origin "https://gitlab.com:443")) + (not (and trusted-key (string=? trusted-key origin)))) + (error 'jgl-url + "authenticated custom GitLab origins require --trusted-origin" + origin)) + (make-jgl-client normalized token origin allow-insecure?))) ;; --- Percent-encoding (RFC 3986 unreserved set kept literal) --- ;; Used for project paths ("group/sub/proj" -> "group%2Fsub%2Fproj") and @@ -68,11 +211,19 @@ ;; Build an API path: "projects/123/issues" -> ".../api/v4/projects/123/issues" (def (api-path c path) + (when (or (not (string? path)) (string-has-forbidden-url-char? path) + (string-prefix? "//" path)) + (error 'gitlab "invalid API path")) (string-append (client-base-url c) "/api/v4/" path)) - (def (auth-headers c) - (list (cons "PRIVATE-TOKEN" (client-token c)) - (cons "Accept" "application/json"))) + (def (auth-headers c url) + (unless (gitlab-same-origin? c url) + (error 'gitlab "refusing to send credentials across origins")) + (append + (if (string=? (client-token c) "") + '() + (list (cons "PRIVATE-TOKEN" (client-token c)))) + (list (cons "Accept" "application/json")))) (def (string-index-char s ch) (let loop ([i 0]) @@ -103,7 +254,7 @@ ;; Raw authenticated GET. Returns (values status body-text). (def (gl-request c path) (let* ([url (api-path c path)] - [req (http-get url (auth-headers c) #f)] + [req (http-get url (auth-headers c url) #f)] [status (request-status req)] [body (request-text req)]) (request-close req) @@ -148,20 +299,25 @@ acc* (loop (+ page 1) acc*)))))) - ;; Download an absolute URL with auth into `dest`. Returns #t/#f. - (def (gl-download c url dest) - (let* ([req (http-get url (list (cons "PRIVATE-TOKEN" (client-token c))) #f)] + (def (download-content c url) + (unless (gitlab-same-origin? c url) + (error 'gitlab "refusing cross-origin authenticated download" url)) + (let* ([req (http-get url (auth-headers c url) #f)] [status (request-status req)]) (if (and (>= status 200) (< status 300)) (let ([content (request-content req)]) (request-close req) - (call-with-port - (open-file-output-port dest (file-options no-fail) (buffer-mode block)) - (lambda (p) - (if (bytevector? content) - (put-bytevector p content) - (put-bytevector p (string->utf8 content))))) - #t) + content) (begin (request-close req) #f)))) + ;; Authenticated downloads never follow redirects (std net request does not + ;; follow them) and are published exclusively at mode 0600. + (def (gl-download-at c url dirfd name) + (let ([content (download-content c url)]) + (and content (secure-write-exclusive-at dirfd name content)))) + + (def (gl-download c url dest) + (let ([content (download-content c url)]) + (and content (secure-write-exclusive-file dest content)))) + ) ;; end library --- a/lib/jgl/config.ss +++ b/lib/jgl/config.ss @@ -21,7 +21,8 @@ (library (jgl config) (export make-opts opts? opts-base-url opts-token opts-project opts-format - resolve-opts opts->client default-config-path) + opts-trusted-origin opts-allow-insecure-loopback? + resolve-opts opts->client default-config-path read-token-from-fd) (import (except (chezscheme) make-hash-table hash-table? sort sort! @@ -35,32 +36,29 @@ (std misc string) (std misc ports) (std text yaml) - (jgl client)) + (jgl client) + (jgl secure-fs)) - (defstruct opts (base-url token project format)) + (defstruct opts + (base-url token project format trusted-origin allow-insecure-loopback?)) (def (env name) (let ([v (getenv name)]) (if (and v (not (string=? v ""))) v #f))) - (def (strip-trailing-slash s) - (if (and (> (string-length s) 0) - (char=? (string-ref s (- (string-length s) 1)) #\/)) - (substring s 0 (- (string-length s) 1)) - s)) - ;; ~/.gitlab.yaml unless overridden by --config / GITLAB_CONFIG. (def (default-config-path) (let ([h (getenv "HOME")]) (if (and h (not (string=? h ""))) (string-append h "/.gitlab.yaml") #f))) - ;; Load the YAML config into a flat alist of string->value. Missing file or a - ;; parse error yields '() (config is best-effort; flags/env still work). + ;; A present config is credential material, so insecure metadata or invalid + ;; YAML fails closed instead of silently falling through to another source. (def (load-yaml-config path) (if (and path (file-exists? path)) - (guard (e (#t '())) - (let ([parsed (yaml-load-string (read-file-string path))]) - (if (and (list? parsed) (or (null? parsed) (pair? (car parsed)))) parsed '()))) + (let ([parsed (yaml-load-string (secure-read-private-text-file path))]) + (if (and (list? parsed) (or (null? parsed) (pair? (car parsed)))) + parsed + (error 'jgl-config "config must contain a flat YAML mapping" path))) '())) ;; Look up a string key; coerce scalars to a non-empty string, else #f. @@ -76,18 +74,60 @@ [else #f])) #f))) + (def (true-value? value) + (and value + (member (string-downcase (if (string? value) value (format "~a" value))) + '("1" "true" "yes")))) + + (def (read-token-from-fd raw-fd) + (let ([fd (cond [(and (integer? raw-fd) (exact? raw-fd)) raw-fd] + [(string? raw-fd) (string->number raw-fd)] + [else #f])]) + (unless (and (integer? fd) (exact? fd) (>= fd 0) (<= fd 1048575)) + (error 'jgl-token "--token-fd must be a nonnegative descriptor" raw-fd)) + (let ([port (open-fd-input-port fd (buffer-mode block) #f)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let loop ([bytes '()] [count 0]) + (when (>= count 4096) + (error 'jgl-token "token exceeds 4096 bytes")) + (let ([b (get-u8 port)]) + (cond + [(or (eof-object? b) (= b 10)) + (let* ([ordered (reverse bytes)] + [ordered (if (and (pair? ordered) (= (car (reverse ordered)) 13)) + (reverse (cdr (reverse ordered))) + ordered)]) + (when (null? ordered) (error 'jgl-token "token descriptor was empty")) + (utf8->string (u8-list->bytevector ordered)))] + [(= b 0) (error 'jgl-token "token contains a NUL byte")] + [else (loop (cons b bytes) (+ count 1))])))) + (lambda () (close-port port)))))) + ;; Build resolved options. CLI values (any may be #f) win, then env, then the - ;; config file at `config-path` (or ~/.gitlab.yaml), then defaults. - (def (resolve-opts url token project format config-path) - (let ([cfg (load-yaml-config (or config-path (env "GITLAB_CONFIG") (default-config-path)))]) - (make-opts - (strip-trailing-slash - (or url (env "GITLAB_URL") (cfg-ref cfg "url") "https://gitlab.com")) - (or token (env "GITLAB_TOKEN") (cfg-ref cfg "token") #f) - (or project (env "GITLAB_PROJECT") (cfg-ref cfg "project") #f) - (or format (env "GITLAB_FORMAT") (cfg-ref cfg "format") "text")))) + ;; owner-only config file, then defaults. + (def resolve-opts + (case-lambda + [(url token project format config-path) + (resolve-opts url token project format config-path #f #f)] + [(url token project format config-path trusted-origin allow-insecure?) + (let ([cfg (load-yaml-config + (or config-path (env "GITLAB_CONFIG") (default-config-path)))]) + (make-opts + (or url (env "GITLAB_URL") (cfg-ref cfg "url") "https://gitlab.com") + (or token (env "GITLAB_TOKEN") (cfg-ref cfg "token") #f) + (or project (env "GITLAB_PROJECT") (cfg-ref cfg "project") #f) + (or format (env "GITLAB_FORMAT") (cfg-ref cfg "format") "text") + (or trusted-origin (env "GITLAB_TRUSTED_ORIGIN") + (cfg-ref cfg "trusted_origin") #f) + (or allow-insecure? + (true-value? (env "GITLAB_ALLOW_INSECURE_LOOPBACK")) + (true-value? (cfg-ref cfg "allow_insecure_loopback")))))])) (def (opts->client o) - (make-client (opts-base-url o) (or (opts-token o) ""))) + (make-client (opts-base-url o) (or (opts-token o) "") + (opts-trusted-origin o) + (opts-allow-insecure-loopback? o))) ) ;; end library --- a/lib/jgl/format.ss +++ b/lib/jgl/format.ss @@ -8,7 +8,7 @@ (library (jgl format) (export jref jstr jint json->string short-date user->string labels->string truncate-str - pad-right) + pad-right terminal-safe-inline terminal-safe-block) (import (except (chezscheme) make-hash-table hash-table? sort sort! @@ -50,25 +50,75 @@ [(char=? ch #\newline) (display "\\n" out)] [(char=? ch #\return) (display "\\r" out)] [(char=? ch #\tab) (display "\\t" out)] + [(json-escape-codepoint? (char->integer ch)) + (display "\\u" out) + (display (hex-pad (char->integer ch) 4) out)] [else (write-char ch out)])) (string->list s)) (write-char #\" out) (get-output-string out))) - ;; Serialize any decoded JSON value back to a JSON string. Objects go through - ;; json-object->string; arrays are joined element-wise (json-object->string - ;; rejects top-level arrays). + (def (hex-pad n width) + (let ([raw (string-upcase (number->string n 16))]) + (string-append (make-string (max 0 (- width (string-length raw))) #\0) raw))) + + (def (bidi-control-codepoint? n) + (or (= n #x061c) (= n #x200e) (= n #x200f) + (and (>= n #x202a) (<= n #x202e)) + (and (>= n #x2066) (<= n #x2069)))) + + (def (json-escape-codepoint? n) + (or (< n 32) (and (>= n 127) (<= n 159)) + (= n #x2028) (= n #x2029) (bidi-control-codepoint? n)))