Harden credentials and S3 transport
ober
4807da849f0d22e951930fad9d78e38a51f5ed4c
--- 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/Makefile +++ b/Makefile @@ -13,11 +13,16 @@ JERBUILD ?= $(shell if [ -x ./jerbuild ]; then echo ./jerbuild; \ JH = $(shell "$(JERBUILD)" --jerboa-home 2>/dev/null) NATIVE_DIR = $(JH)/jerboa-native-rs/target/release +NATIVE_LIB = $(shell if [ -f "$(NATIVE_DIR)/libjerboa_native.so" ]; then \ + echo "$(NATIVE_DIR)/libjerboa_native.so"; \ + elif [ -f "$(NATIVE_DIR)/libjerboa_native.dylib" ]; then \ + echo "$(NATIVE_DIR)/libjerboa_native.dylib"; fi) LIBDIRS = --libdirs lib:$(JH)/lib JEXEC = "$(JERBUILD)" exec $(LIBDIRS) BIN := jerboa-aws BIN_DIR := $(HOME)/.local/bin DYLD = DYLD_LIBRARY_PATH="$(NATIVE_DIR):$$DYLD_LIBRARY_PATH" DYLD_FALLBACK_LIBRARY_PATH="$(NATIVE_DIR)" LD_LIBRARY_PATH="$(NATIVE_DIR):$$LD_LIBRARY_PATH" +DEV_NATIVE = JERBOA_DEV_NATIVE=1 JERBOA_NATIVE_LIB="$(NATIVE_LIB)" DIST_DIR ?= $(CURDIR)/dist RELEASE_EVIDENCE_DIR ?= $(DIST_DIR)/release-evidence TARGET_EVIDENCE_DIR ?= $(DIST_DIR)/target-evidence @@ -61,7 +66,10 @@ run: binary ./$(BIN) $(ARGS) test: native-runtime - $(DYLD) $(JEXEC) test/test-all.ss + @test -n "$(NATIVE_LIB)" || { echo "ERROR: dynamic jerboa-native test library was not built."; exit 1; } + $(DYLD) $(DEV_NATIVE) $(JEXEC) test/test-all.ss + @command -v python3 >/dev/null 2>&1 || { echo "ERROR: python3 is required for transport tests."; exit 1; } + $(DYLD) $(DEV_NATIVE) JERBUILD="$(JERBUILD)" JERBOA_LIBDIRS="$(CURDIR)/lib:$(JH)/lib" python3 test/test-s3-transport.py security: @set -eu; \ --- a/README.md +++ b/README.md @@ -17,6 +17,18 @@ requests, resource metadata, and service responses. Use short-lived role or SSO credentials where possible, avoid long-lived IAM user keys, and do not pass secrets in argv on shared systems. +Custom S3 endpoints require HTTPS. Plain HTTP exists only for local integration +tests and requires all three of a canonical `127.x.y.z` literal, path-style +addressing, and the explicit `allow-insecure-loopback:` constructor flag. The +HTTP client returns redirects to the caller and never forwards signed headers +or session tokens to a redirect target. + +Use `jerboa-aws ssm put-parameter --value-stdin` for parameter values, +especially `SecureString`; the legacy `--value` form warns for secure values. +PSSM strips remote terminal controls in human output, supports +`--literal-controls` for visible `\xNN` rendering, and honors `--no-color`. +Use `--json` when lossless remote output is required. + Credential handling, logging expectations, and release requirements are documented in [`docs/credential-handling.md`](docs/credential-handling.md). SigV4 signing uses Jerboa's bundled Rust-backed native crypto; see --- a/SECURITY.md +++ b/SECURITY.md @@ -33,6 +33,18 @@ experimental until the release checklist in `~/Release-plan.md` and - SigV4 uses Jerboa's bundled Rust-backed native crypto bindings for SHA-256 and HMAC-SHA256. The previous PATH-resolved OpenSSL CLI dependency has been removed from request signing. +- S3 endpoints are HTTPS-only by default. The only plaintext exception requires + an explicit test flag, canonical IPv4 `127/8` authority, and path-style + addressing; hostnames, remote addresses, endpoint paths, and implicit HTTP + are rejected before credential resolution. Redirects are not followed. +- Supply SSM parameter values through `--value-stdin`. `SecureString` values on + `--value` remain temporarily compatible but emit a deprecation warning and + can be exposed through process listings, shell history, or CI telemetry. +- PSSM human output strips C0/C1/ESC controls from every remote/cache field. + `--literal-controls` renders them visibly, `--no-color` suppresses all + program ANSI, and JSON remains the lossless automation interface. +- Release tests must retain the S3 loopback/redirect origin harness, hostile + OSC/CSI/C0/C1 rendering vectors, and SSM stdin source/size boundaries. Credential, service-data, and crypto-dependency details are documented in [`docs/credential-handling.md`](docs/credential-handling.md) and --- a/docs/credential-handling.md +++ b/docs/credential-handling.md @@ -28,6 +28,48 @@ chmod 0600 ~/.aws/credentials ~/.aws/config 2>/dev/null || true Do not pass AWS secrets in argv on shared systems. Shell history and process listings can expose argv. +### SSM parameter values + +Read parameter values from standard input so they do not appear in argv: + +```sh +printf '%s' "$SSM_VALUE" | + jerboa-aws ssm put-parameter \ + --name /example/secret \ + --type SecureString \ + --value-stdin +``` + +Input is preserved exactly, including a trailing newline, and is capped at +8192 characters and 8192 UTF-8 bytes. Prefer `printf` over `echo` when a newline +is not part of the value. Exactly one of `--value-stdin` or legacy `--value` +must be supplied. The legacy argv form emits a warning for `SecureString` and +must not be used in shared hosts, CI, shell history, process supervisors, crash +reports, or audit-command capture. + +### S3 transport boundary + +`S3Client` requires HTTPS for AWS and custom S3-compatible endpoints. A narrow +plaintext mode exists only for local tests: + +```scheme +(S3Client + 'endpoint: "http://127.0.0.1:9000" + 'path-style: #t + 'allow-insecure-loopback: #t + 'access-key: "test-only" + 'secret-key: "test-only" + 'region: "us-test-1") +``` + +The exception accepts only canonical dotted-decimal IPv4 addresses in `127/8` +with an optional valid port. It rejects `localhost`, DNS names, non-loopback +addresses, ambiguous numeric spellings, virtual-host bucket addressing, +userinfo, paths, queries, fragments, and implicit opt-in. Validation occurs +before credential resolution and again at request-target construction. HTTP +redirect responses are returned without following them, so signed headers and +session tokens are not forwarded to another origin. + ## Logging And Errors Do not log: @@ -42,6 +84,12 @@ Do not log: Error paths should report service, operation, status, and a redacted summary rather than raw request headers or full service response bodies. +PSSM treats instance names, IDs, regions, statuses, errors, stdout, and stderr +as hostile terminal text. Human output strips C0, C1, DEL, and ESC controls; +`--literal-controls` renders those code points as visible hexadecimal escapes. +`--no-color` removes program-generated ANSI as well. `--json` preserves the +remote strings through JSON escaping and is recommended for automation. + ## SigV4 Crypto Dependency SigV4 SHA-256 and HMAC-SHA256 use Jerboa's bundled Rust-backed native crypto --- a/docs/release-evidence.md +++ b/docs/release-evidence.md @@ -7,6 +7,12 @@ The evidence bundle contains: - high-confidence tracked-file secret-scan output; - unit-test output; +- an adversarial S3 transport test that permits only explicit literal-loopback + HTTP, records the signed primary request, returns a cross-origin redirect, and + proves the redirect target receives no request or credential header; +- terminal-control and secret-input regressions covering OSC/CSI/C0/C1 bytes, + no-color/literal rendering, JSON losslessness, conflicting secret sources, + and limit−1/limit/limit+1 stdin behavior; - standalone binary build and `--help` smoke output; - SBOM-style source, workflow, binary, toolchain, and native dependency manifests; @@ -31,6 +37,11 @@ release platform, history secret scan, live least-privilege AWS account smoke, SSO/STS credential-flow review, and external review of service-specific mutating operations are still required before production claims. +The local S3 harness proves application redirect behavior and the literal +loopback exception; it is not a packet capture of a production TLS path. Before +release, retain a target-host capture or equivalent independent observation +showing that no credential-bearing bytes are emitted before TLS establishment. + ## Target AWS Proof Local `make release-evidence` always writes --- a/lib/jerboa-aws/cli/format.sls +++ b/lib/jerboa-aws/cli/format.sls @@ -152,7 +152,10 @@ ((char=? c #\newline) (put-string port "\\n")) ((char=? c #\return) (put-string port "\\r")) ((char=? c #\tab) (put-string port "\\t")) - ((< (char->integer c) #x20) + ((or (< (char->integer c) #x20) + (= (char->integer c) #x7f) + (and (>= (char->integer c) #x80) + (<= (char->integer c) #x9f))) (put-string port (format "\\u~4,'0x" (char->integer c)))) (else (put-char port c))))) (put-char port #\")) --- a/lib/jerboa-aws/cli/main.sls +++ b/lib/jerboa-aws/cli/main.sls @@ -2,7 +2,7 @@ ;;; (jerboa-aws cli main) -- CLI entry point with subcommand dispatch (library (jerboa-aws cli main) - (export main) + (export main resolve-ssm-parameter-value) (import (chezscheme) (jerboa-aws json) (jerboa-aws cli format) @@ -87,6 +87,68 @@ ((string=? (car rest) name) #t) (else (loop (cdr rest)))))) + (define MAX-SSM-PARAMETER-VALUE-CHARS 8192) + (define MAX-SSM-PARAMETER-VALUE-BYTES 8192) + + (define (option-count args name) + (let loop ((rest args) (count 0)) + (cond + ((null? rest) count) + ((string=? (car rest) name) + (loop (cdr rest) (+ count 1))) + (else (loop (cdr rest) count))))) + + ;; Read at most one AWS advanced-parameter value. The character limit is + ;; enforced while reading so a hostile pipe cannot force unbounded growth; + ;; the UTF-8 byte limit is then checked against SSM's 8 KiB ceiling. + (define (read-ssm-parameter-value port) + (let ((out (open-output-string))) + (let loop ((count 0)) + (let ((ch (get-char port))) + (cond + ((eof-object? ch) + (let ((value (get-output-string out))) + (when (> (bytevector-length (string->utf8 value)) + MAX-SSM-PARAMETER-VALUE-BYTES) + (error 'ssm + "parameter value from stdin exceeds 8192 UTF-8 bytes")) + value)) + ((>= count MAX-SSM-PARAMETER-VALUE-CHARS) + (error 'ssm + "parameter value from stdin exceeds 8192 characters")) + (else + (put-char out ch) + (loop (+ count 1)))))))) + + ;; Select exactly one secret source. This helper is exported so the source + ;; selection, bounded read, and warning behavior can be regression-tested + ;; without making an AWS request. + (define (resolve-ssm-parameter-value args type input-port warning-port) + (let ((argv-count (option-count args "--value")) + (stdin-count (option-count args "--value-stdin"))) + (when (> argv-count 1) + (error 'ssm "put-parameter accepts --value only once")) + (when (> stdin-count 1) + (error 'ssm "put-parameter accepts --value-stdin only once")) + (when (and (> argv-count 0) (> stdin-count 0)) + (error 'ssm + "put-parameter accepts exactly one of --value or --value-stdin")) + (cond + ((= stdin-count 1) + (read-ssm-parameter-value input-port)) + ((= argv-count 1) + (let ((value (get-opt args "--value"))) + (unless value + (error 'ssm "--value requires an argument")) + (when (string=? type "SecureString") + (display + "Warning: --value exposes SecureString data in argv; use --value-stdin instead.\n" + warning-port)) + value)) + (else + (error 'ssm + "put-parameter requires --value-stdin (recommended) or --value"))))) + ;; Parse comma-separated string into list (define (parse-csv str) (if (or (not str) (string=? str "")) @@ -715,13 +777,15 @@ For low-level API commands use 's3api': ((string=? action "put-parameter") (let ((name (or (get-opt args "--name") (error 'ssm "put-parameter requires --name"))) - (value (or (get-opt args "--value") - (error 'ssm "put-parameter requires --value"))) (type (or (get-opt args "--type") "String")) (overwrite (get-flag args "--overwrite"))) - (output-result - (put-parameter client name value 'type: type 'overwrite: overwrite) - output-fmt))) + (let ((value (resolve-ssm-parameter-value + args type + (current-input-port) + (current-error-port)))) + (output-result + (put-parameter client name value 'type: type 'overwrite: overwrite) + output-fmt)))) ((string=? action "get-parameter") (let ((name (or (get-opt args "--name") (error 'ssm "get-parameter requires --name"))) @@ -763,7 +827,7 @@ For low-level API commands use 's3api': output-fmt))) ((or (string=? action "help") (string=? action "--help")) (display "jerboa-aws ssm commands: - put-parameter --name NAME --value VALUE [--type TYPE] [--overwrite] + put-parameter --name NAME (--value-stdin | --value VALUE) [--type TYPE] [--overwrite] get-parameter --name NAME [--with-decryption] get-parameters --names NAME1,NAME2 [--with-decryption] delete-parameter --name NAME @@ -772,6 +836,9 @@ For low-level API commands use 's3api': get-command-invocation --command-id ID --instance-id ID For parallel SSM execution, use the 'pssm' command instead. + +For SecureString values, --value-stdin is strongly recommended. Input is read +exactly (including a trailing newline) and is limited to 8192 UTF-8 bytes. ") (exit 0)) (else --- a/lib/jerboa-aws/json.sls +++ b/lib/jerboa-aws/json.sls @@ -170,7 +170,10 @@ [(char=? c #\tab) (put-string port "\\t")] [(char=? c #\backspace) (put-string port "\\b")] [(char=? c #\page) (put-string port "\\f")] - [(< (char->integer c) #x20) + [(or (< (char->integer c) #x20) + (= (char->integer c) #x7f) + (and (>= (char->integer c) #x80) + (<= (char->integer c) #x9f))) (put-string port (format "\\u~4,'0x" (char->integer c)))] [else (put-char port c)]))) (put-char port #\")) --- a/lib/jerboa-aws/pssm.sls +++ b/lib/jerboa-aws/pssm.sls @@ -4,7 +4,11 @@ ;;; sends SSM commands in batches, polls for results. (library (jerboa-aws pssm) - (export pssm-main) + (export pssm-main + parse-pssm-args + pssm-terminal-sanitize + pssm-terminal-literal + pssm-render-host-result) (import (chezscheme) (jerboa-aws json) (jerboa-aws ssm api) @@ -17,6 +21,39 @@ (lambda (p) (display-condition e p))) (format "~a" e))) + ;; Human-facing terminal output must never interpret bytes supplied by a + ;; managed host, AWS response, or instance cache. Default rendering removes + ;; every C0/C1 control and DEL. Literal mode preserves their information as + ;; visible hexadecimal text; neither mode emits an attacker-supplied ESC. + (define (terminal-control? ch) + (let ([n (char->integer ch)]) + (or (< n #x20) + (= n #x7f) + (and (>= n #x80) (<= n #x9f))))) + + (define (pssm-terminal-sanitize text) + (let ([out (open-output-string)]) + (string-for-each + (lambda (ch) + (unless (terminal-control? ch) + (put-char out ch))) + text) + (get-output-string out))) + + (define (pssm-terminal-literal text) + (let ([out (open-output-string)]) + (string-for-each + (lambda (ch) + (let ([n (char->integer ch)]) + (if (terminal-control? ch) + (put-string out + (if (<= n #xff) + (format "\\x~2,'0x" n) + (format "\\u~4,'0x" n))) + (put-char out ch)))) + text) + (get-output-string out))) + ;; ---- Constants ---- (define SSM-BATCH-SIZE 50) (define DEFAULT-TIMEOUT 60) ;; seconds @@ -33,6 +70,12 @@ (let ([v (ht-ref ht key "")]) (if (string? v) v ""))) + (define (render-human config value) + (let ([text (if (string? value) value (format "~a" value))]) + (if (ht-ref config "literal-controls") + (pssm-terminal-literal text) + (pssm-terminal-sanitize text)))) + ;; ---- Instance cache ---- (define (default-cache-file) @@ -190,7 +233,7 @@ (when verbose (display (format " [~a] Sending ~a batch~a (~a instances)...\n" - region (length batches) + (render-human config region) (length batches) (if (= (length batches) 1) "" "es") (length region-instances))) (flush-output-port (current-output-port))) @@ -213,8 +256,9 @@ (- (current-seconds) (ht-ref r "start_time" 0)))))) ids) (when verbose - (display (format " [~a] Batch failed: ~a\n" region - (condition->string e))))]) + (display (format " [~a] Batch failed: ~a\n" + (render-human config region) + (render-human config (condition->string e)))))]) (let* ([resp (apply send-command client ids command (append (list 'document-name: document-name) @@ -225,7 +269,9 @@ (error 'pssm "No CommandId returned from SendCommand")) (when verbose (display (format " [~a] Command ID: ~a (~a instances)\n" - region cmd-id (length ids)))) + (render-human config region) + (render-human config cmd-id) + (length ids)))) ;; Record command-id on results (for-each (lambda (id) @@ -264,7 +310,9 @@ (- (current-seconds) (ht-ref r "start_time" 0))) (when verbose (display (format " [~a] ~a: ~a\n" - region (ht-ref/str r "name") status)))))))))) + (render-human config region) + (render-human config (ht-ref/str r "name")) + (render-human config status))))))))))) pending) (poll-loop (- (current-seconds) start-time))))) @@ -327,10 +375,12 @@ (= (ht-ref r "exit_code" -1) 0) (string=? (ht-ref/str r "error") ""))) - (define (output-pretty exec-result) + (define (output-pretty exec-result config) (let* ([results (ht-ref exec-result "results")] [successes (filter result-success? results)] - [failures (filter (lambda (r) (not (result-success? r))) results)]) + [failures (filter (lambda (r) (not (result-success? r))) results)] + [no-color? (ht-ref config "no-color")] + [literal? (ht-ref config "literal-controls")]) (display "\n") (display (make-string 80 #\=)) @@ -338,42 +388,73 @@ (display (format "PSSM Results: ~a/~a succeeded | Pattern: ~a | Duration: ~,2fs\n" (ht-ref exec-result "success_count") (ht-ref exec-result "total_hosts") - (ht-ref/str exec-result "pattern") + (render-human config (ht-ref/str exec-result "pattern")) (ht-ref exec-result "total_duration"))) (display (make-string 80 #\=)) (display "\n\n") ;; Print successes first - (for-each (lambda (r) (print-host-result r #t)) successes) + (for-each + (lambda (r) + (display (pssm-render-host-result r #t no-color? literal?))) + successes) ;; Then failures - (for-each (lambda (r) (print-host-result r #f)) failures))) - - (define (print-host-result r success?) - (let ([name (ht-ref/str r "name")] - [inst-id (ht-ref/str r "instance_id")] - [region (ht-ref/str r "region")] - [status (ht-ref/str r "status")] - [stdout (ht-ref/str r "stdout")] - [stderr (ht-ref/str r "stderr")] - [err (ht-ref/str r "error")] - [duration (ht-ref r "duration" 0)]) - (if success? - (display (format "\033[32m~a [~a]\033[0m (~,2fs) [~a]\n" "OK" name duration region)) - (display (format "\033[31m~a [~a]\033[0m (~,2fs) [~a]\n" "FAIL" name duration region))) - (display (format " Instance: ~a | Status: ~a\n" inst-id status)) - (unless (string=? err "") - (display (format " \033[31mError: ~a\033[0m\n" err))) - (unless (string=? stdout "") - (display " --- stdout ---\n") - (for-each - (lambda (line) (display (format " | ~a\n" line))) - (string-split-lines (string-trim-right stdout #\newline)))) - (unless (string=? stderr "") - (display " --- stderr ---\n") - (for-each - (lambda (line) (display (format " | \033[33m~a\033[0m\n" line))) - (string-split-lines (string-trim-right stderr #\newline)))) - (newline))) + (for-each + (lambda (r) + (display (pssm-render-host-result r #f no-color? literal?))) + failures))) + + (define (pssm-render-host-result r success? no-color? literal?) + (define (safe text) + (if literal? + (pssm-terminal-literal text) + (pssm-terminal-sanitize text))) + (call-with-string-output-port + (lambda (out) + (let ([name (safe (ht-ref/str r "name"))] + [inst-id (safe (ht-ref/str r "instance_id"))] + [region (safe (ht-ref/str r "region"))] + [status (safe (ht-ref/str r "status"))] + [stdout (ht-ref/str r "stdout")] + [stderr (ht-ref/str r "stderr")] + [err (safe (ht-ref/str r "error"))] + [duration (ht-ref r "duration" 0)]) + (cond + [no-color? + (put-string out + (format "~a [~a] (~,2fs) [~a]\n" + (if success? "OK" "FAIL") name duration region))] + [success? + (put-string out + (format "\033[32mOK [~a]\033[0m (~,2fs) [~a]\n" + name duration region))] + [else + (put-string out + (format "\033[31mFAIL [~a]\033[0m (~,2fs) [~a]\n" + name duration region))]) + (put-string out + (format " Instance: ~a | Status: ~a\n" inst-id status)) + (unless (string=? err "") + (put-string out + (if no-color? + (format " Error: ~a\n" err) + (format " \033[31mError: ~a\033[0m\n" err)))) + (unless (string=? stdout "") + (put-string out " --- stdout ---\n") + (for-each + (lambda (line) + (put-string out (format " | ~a\n" (safe line)))) + (string-split-lines (string-trim-right stdout #\newline)))) + (unless (string=? stderr "") + (put-string out " --- stderr ---\n") + (for-each + (lambda (line) + (put-string out + (if no-color? + (format " | ~a\n" (safe line)) + (format " | \033[33m~a\033[0m\n" (safe line))))) + (string-split-lines (string-trim-right stderr #\newline)))) + (newline out))))) (define (output-json exec-result) (display (json-object->string exec-result)) @@ -381,7 +462,7 @@ ;; ---- List instances ---- - (define (list-instances instances json?) + (define (list-instances instances json? config) (if json? (begin (display (json-object->string (list->vector instances))) (newline)) (begin @@ -394,19 +475,22 @@ (lambda (inst) (let ([pub (ht-ref/str inst "public_ip")]) (display (format "~40a ~20a ~16a ~16a ~a\n" - (ht-ref/str inst "name") - (ht-ref/str inst "instance_id") - (ht-ref/str inst "private_ip") - (if (string=? pub "") "-" pub) - (ht-ref/str inst "region"))))) + (render-human config (ht-ref/str inst "name")) + (render-human config (ht-ref/str inst "instance_id")) + (render-human config (ht-ref/str inst "private_ip")) + (if (string=? pub "") "-" (render-human config pub)) + (render-human config (ht-ref/str inst "region")))))) instances)))) ;; ---- Dry run ---- (define (print-dry-run instances config) (display (format "Dry run - would execute SSM command on ~a hosts:\n\n" (length instances))) - (display (format "Document: ~a\n" (or (ht-ref config "document-name") "AWS-RunShellScript"))) - (display (format "Command: ~a\n" (ht-ref/str config "command"))) + (display (format "Document: ~a\n" + (render-human config + (or (ht-ref config "document-name") "AWS-RunShellScript")))) + (display (format "Command: ~a\n" + (render-human config (ht-ref/str config "command")))) (display (format "Timeout: ~as\n\n" (or (ht-ref config "timeout") DEFAULT-TIMEOUT))) (let ([by-region (group-by-region instances)]) (for-each @@ -416,13 +500,13 @@ [num-batches (+ (quotient (length insts) SSM-BATCH-SIZE) (if (> (remainder (length insts) SSM-BATCH-SIZE) 0) 1 0))]) (display (format "Region ~a (~a instances, ~a batch~a):\n" - region (length insts) num-batches + (render-human config region) (length insts) num-batches (if (= num-batches 1) "" "es"))) (for-each (lambda (inst) (display (format " - ~a (~a)\n" - (ht-ref/str inst "name") - (ht-ref/str inst "instance_id")))) + (render-human config (ht-ref/str inst "name")) + (render-human config (ht-ref/str inst "instance_id"))))) insts))) by-region))) @@ -469,6 +553,9 @@ [(string=? (car rest) "--no-color") (hashtable-set! config "no-color" #t) (loop (cdr rest) positional)] + [(string=? (car rest) "--literal-controls") + (hashtable-set! config "literal-controls" #t) + (loop (cdr rest) positional)] ;; Options with values [(and (string=? (car rest) "-t") (pair? (cdr rest))) (hashtable-set! config "timeout" (string->number (cadr rest))) @@ -532,6 +619,7 @@ Options: --json Output results as JSON -v, --verbose Verbose output --no-color Disable ANSI colors + --literal-controls Show remote control bytes as visible \\xNN text -h, --help Show this help ")) @@ -561,17 +649,18 @@ Options: [matched (filter-instances instances pattern)]) (when (null? matched) - (display (format "No instances match pattern: ~a\n" pattern) + (display (format "No instances match pattern: ~a\n" + (render-human config pattern)) (current-error-port)) (exit 1)) (when verbose (display (format "Matched ~a instances for pattern '~a'\n" - (length matched) pattern))) + (length matched) (render-human config pattern)))) ;; List only (when list-only - (list-instances matched json?) + (list-instances matched json? config) (exit 0)) ;; Need a command for execution @@ -589,7 +678,7 @@ Options: (let ([result (execute-ssm matched config)]) (if json? (output-json result) - (output-pretty result)) + (output-pretty result config)) (when (> (ht-ref result "failure_count" 0) 0) (exit 1)))))) --- a/lib/jerboa-aws/s3/api.sls +++ b/lib/jerboa-aws/s3/api.sls @@ -26,16 +26,26 @@ ;; --- Client record --- (define-record-type s3-client - (fields endpoint access-key secret-key region token path-style? scheme) + (fields endpoint access-key secret-key region token path-style? scheme + allow-insecure-loopback?) (protocol (lambda (new) (case-lambda [(endpoint access-key secret-key region token) - (new endpoint access-key secret-key region token #f "https")] + (validate-s3-transport! endpoint "https" #f #f) + (new endpoint access-key secret-key region token #f "https" #f)] [(endpoint access-key secret-key region token path-style?) - (new endpoint access-key secret-key region token path-style? "https")] + (validate-s3-transport! endpoint "https" path-style? #f) + (new endpoint access-key secret-key region token path-style? "https" #f)] [(endpoint access-key secret-key region token path-style? scheme) - (new endpoint access-key secret-key region token path-style? scheme)])))) + (validate-s3-transport! endpoint scheme path-style? #f) + (new endpoint access-key secret-key region token path-style? scheme #f)] + [(endpoint access-key secret-key region token path-style? scheme + allow-insecure-loopback?) + (validate-s3-transport! + endpoint scheme path-style? allow-insecure-loopback?) + (new endpoint access-key secret-key region token path-style? scheme + allow-insecure-loopback?)])))) ;; Client factory with credential resolution (define (S3Client . args) @@ -46,22 +56,34 @@ [region (kw-ref args 'region: #f)] [token (kw-ref args 'token: #f)] [path-style? (kw-ref args 'path-style: #f)] - [scheme (kw-ref args 'scheme: #f)]) - (let-values ([(r-ak r-sk r-region r-token) - (aws-resolve-credentials profile)]) - (let ([ak (or access-key r-ak)] - [sk (or secret-key r-sk)] - [reg (or region r-region)] - [tok (or token r-token)]) - (unless ak (error 'S3Client "access key is required")) - (unless sk (error 'S3Client "secret key is required")) - (let-values ([(endpoint-scheme endpoint-host) - (split-endpoint-scheme - (or endpoint "s3.amazonaws.com"))]) - (make-s3-client - endpoint-host - ak sk reg tok path-style? - (or scheme endpoint-scheme "https"))))))) + [scheme (kw-ref args 'scheme: #f)] + [allow-insecure-loopback? + (kw-ref args 'allow-insecure-loopback: #f)]) + ;; Validate transport before consulting any credential source. A typo in + ;; a custom endpoint must fail without reading or resolving AWS secrets. + (let-values ([(endpoint-scheme endpoint-host) + (split-endpoint-scheme + (or endpoint "s3.amazonaws.com"))]) + (when (and scheme endpoint-scheme + (not (string=? scheme endpoint-scheme))) + (error 'S3Client + "scheme: conflicts with the scheme embedded in endpoint:")) + (let ([effective-scheme (or scheme endpoint-scheme "https")]) + (validate-s3-transport! + endpoint-host effective-scheme path-style? + allow-insecure-loopback?) + (let-values ([(r-ak r-sk r-region r-token) + (aws-resolve-credentials profile)]) + (let ([ak (or access-key r-ak)] + [sk (or secret-key r-sk)] + [reg (or region r-region)] + [tok (or token r-token)]) + (unless ak (error 'S3Client "access key is required")) + (unless sk (error 'S3Client "secret key is required")) + (make-s3-client + endpoint-host + ak sk reg tok path-style? effective-scheme + allow-insecure-loopback?))))))) ;; Precomputed empty SHA256 (define empty-sha256 (sha256 #vu8())) @@ -274,6 +296,13 @@ ;; --- Helpers --- (define (s3-build-request-target client bucket key query) + ;; Revalidate at the send boundary as defense in depth. Records are + ;; immutable today, but this keeps signing and transport policy adjacent. + (validate-s3-transport! + (s3-client-endpoint client) + (s3-client-scheme client) + (s3-client-path-style? client) + (s3-client-allow-insecure-loopback? client)) (let* ([scheme (s3-client-scheme client)] [endpoint (s3-client-endpoint client)] [encoded-key (if key (s3-encode-key-path key) "")] @@ -390,6 +419,104 @@ (values "http" (substring endpoint 7 (string-length endpoint)))] [else (values #f endpoint)])) + ;; Plain HTTP is intentionally limited to an explicit local test mode. Use + ;; only canonical dotted-decimal 127/8 addresses so no DNS lookup or hostname + ;; rebinding can turn the exception into a credential-bearing remote request. + (define (validate-s3-transport! endpoint scheme path-style? + allow-insecure-loopback?) + (unless (and (string? endpoint) (> (string-length endpoint) 0)) + (error 'S3Client "endpoint must be a non-empty authority")) + (unless (and (string? scheme) + (or (string=? scheme "https") (string=? scheme "http"))) + (error 'S3Client "S3 endpoint scheme must be https" scheme)) + (unless (boolean? allow-insecure-loopback?) + (error 'S3Client "allow-insecure-loopback: must be boolean")) + (validate-endpoint-authority! endpoint) + (when (string=? scheme "http") + (unless allow-insecure-loopback? + (error 'S3Client + "plaintext S3 endpoints are disabled; HTTPS is required")) + (unless path-style? + (error 'S3Client + "insecure loopback testing requires path-style: #t")) + (unless (literal-ipv4-loopback-authority? endpoint) + (error 'S3Client + "insecure loopback endpoint must be a literal 127/8 IPv4 address" + endpoint)))) + + (define (validate-endpoint-authority! authority) + (when (string-any? + (lambda (c) + (or (char=? c #\/) + (char=? c #\?) + (char=? c #\#) + (char=? c #\@) + (char-whitespace? c) + (< (char->integer c) #x20) + (= (char->integer c) #x7f))) + authority) + (error 'S3Client + "endpoint must contain only a host and optional port" authority))) + + (define (literal-ipv4-loopback-authority? authority) + (let-values ([(host port) (split-host-port authority)]) + (and host + (or (not port) (valid-port? port)) + (let ([octets (split-on-char host #\.)]) + (and (= (length octets) 4) + (string=? (car octets) "127") + (for-all canonical-ipv4-octet? octets)))))) + + (define (split-host-port authority) + (let loop ([i 0] [colon #f]) + (cond + [(= i (string-length authority)) + (if colon + (values (substring authority 0 colon) + (substring authority (+ colon 1) + (string-length authority))) + (values authority #f))] + [(char=? (string-ref authority i) #\:) + (if colon + (values #f #f) + (loop (+ i 1) i))] + [else (loop (+ i 1) colon)]))) + + (define (valid-port? text) + (and (> (string-length text) 0) + (string-all? char-numeric? text) + (let ([port (string->number text)]) + (and port (integer? port) (<= 1 port 65535))))) + + (define (canonical-ipv4-octet? text) + (and (> (string-length text) 0) + (string-all? char-numeric? text) + (or (= (string-length text) 1) + (not (char=? (string-ref text 0) #\0))) + (let ([n (string->number text)]) + (and n (integer? n) (<= 0 n 255))))) + + (define (split-on-char text separator) + (let loop ([i 0] [start 0] [parts '()]) + (cond + [(= i (string-length text)) + (reverse (cons (substring text start i) parts))] + [(char=? (string-ref text i) separator) + (loop (+ i 1) (+ i 1) (cons (substring text start i) parts))] + [else (loop (+ i 1) start parts)]))) + + (define (string-any? predicate text) + (let loop ([i 0]) + (and (< i (string-length text)) + (or (predicate (string-ref text i)) + (loop (+ i 1)))))) + + (define (string-all? predicate text) + (let loop ([i 0]) + (or (= i (string-length text)) + (and (predicate (string-ref text i)) + (loop (+ i 1)))))) + (define (string-prefix? prefix str) (and (>= (string-length str) (string-length prefix)) (string=? (substring str 0 (string-length prefix)) prefix))) new file mode 100644 --- /dev/null +++ b/test/s3-loopback-client.ss @@ -0,0 +1,31 @@ +#!chezscheme +(import (jerboa-aws s3 api) + (jerboa-aws request)) + +(define args (command-line)) +(define port + (and (pair? args) + (string->number (car (reverse args))))) + +(unless port + (error 's3-loopback-client "expected loopback server port")) + +(define client + (S3Client + 'endpoint: (string-append "http://127.0.0.1:" (number->string port)) + 'access-key: "access-test" + 'secret-key: "secret-test" + 'token: "session-token-test" + 'region: "us-test-1" + 'path-style: #t + 'allow-insecure-loopback: #t)) + +(define response + (s3-request client 'verb: "GET" 'bucket: "bucket" 'key: "object")) +(define status (request-status response)) +(request-close response) + +(unless (= status 307) + (error 's3-loopback-client "expected redirect response without following it" status)) + +(display "ok - loopback response returned without redirect forwarding\n") --- a/test/test-all.ss +++ b/test/test-all.ss @@ -1,7 +1,15 @@ #!chezscheme (import (jerboa-aws s3 api) (jerboa-aws s3 objects) - (jerboa-aws ec2 params)) + (jerboa-aws ec2 params) + (jerboa-aws json) + (only (jerboa-aws pssm) + parse-pssm-args + pssm-terminal-sanitize + pssm-terminal-literal + pssm-render-host-result) + (only (jerboa-aws cli main) + resolve-ssm-parameter-value)) (define failures 0) @@ -26,13 +34,43 @@ (let ([p (assoc key alist)]) (and p (cdr p)))) +(define (condition->test-string e) + (call-with-string-output-port + (lambda (port) (display-condition e port)))) + +(define (string-has? text needle) + (let ([text-len (string-length text)] + [needle-len (string-length needle)]) + (let loop ([i 0]) + (and (<= (+ i needle-len) text-len) + (or (string=? (substring text i (+ i needle-len)) needle) + (loop (+ i 1))))))) + +(define (check-raises-containing name thunk fragment) + (let ([message (guard (e [#t (condition->test-string e)]) + (thunk) + #f)]) + (check name + (and (string? message) (string-has? message fragment)) + #t))) + +(define (contains-terminal-control? text) + (let loop ([i 0]) + (and (< i (string-length text)) + (let ([n (char->integer (string-ref text i))]) + (or (and (< n #x20) (not (= n #x0a))) + (= n #x7f) + (and (>= n #x80) (<= n #x9f)) + (loop (+ i 1))))))) + (define path-client (S3Client - 'endpoint: "http://localhost:9000" + 'endpoint: "http://127.0.0.1:9000" 'access-key: "ak" 'secret-key: "sk" 'region: "us-test-1" - 'path-style: #t)) + 'path-style: #t + 'allow-insecure-loopback: #t)) (define virtual-client (S3Client @@ -59,7 +97,7 @@ (list (cons "prefix" "a b") (cons "list-type" 2) (cons "continuation-token" "z/y")))]) - (check "path-style host" (alist-ref target 'host) "localhost:9000") + (check "path-style host" (alist-ref target 'host) "127.0.0.1:9000") (check "path-style path" (alist-ref target 'path) "/bucket/dir/a%20b.bin") (check "path-style query" @@ -68,7 +106,76 @@ (check "path-style url" (alist-ref target 'url) - "http://localhost:9000/bucket/dir/a%20b.bin?continuation-token=z%2Fy&list-type=2&prefix=a%20b")) + "http://127.0.0.1:9000/bucket/dir/a%20b.bin?continuation-token=z%2Fy&list-type=2&prefix=a%20b")) + +;; S3 transport policy: TLS by default, with only an explicit canonical 127/8 +;; path-style exception for local integration tests. +(check-raises-containing + "S3 rejects HTTP before credential lookup" + (lambda () (S3Client 'endpoint: "http://198.51.100.9:9000")) + "HTTPS is required") + +(check-raises-containing + "S3 rejects loopback HTTP without opt-in" + (lambda () + (S3Client + 'endpoint: "http://127.0.0.1:9000" + 'access-key: "ak" 'secret-key: "sk" 'region: "test" + 'path-style: #t)) + "HTTPS is required") + +(check-raises-containing + "S3 rejects hostname loopback exception" + (lambda () + (S3Client + 'endpoint: "http://localhost:9000" + 'access-key: "ak" 'secret-key: "sk" 'region: "test" + 'path-style: #t 'allow-insecure-loopback: #t)) + "literal 127/8") + +(check-raises-containing