Add recursive SSM copy command
ober
45d836ba50d5c7343849d921afb626441a9a5a77
--- a/Makefile +++ b/Makefile @@ -144,7 +144,7 @@ release-evidence: @$(MAKE) sbom > "$(RELEASE_EVIDENCE_DIR)/sbom.log" 2>&1 @rm -rf "$(RELEASE_EVIDENCE_DIR)/sbom" @cp -R "$(DIST_DIR)/sbom" "$(RELEASE_EVIDENCE_DIR)/sbom" - @find aws.ss pssm.ss build*.ss lib test support docs scripts .github .jerboa/security.json -type f -print | LC_ALL=C sort | xargs shasum -a 256 > "$(RELEASE_EVIDENCE_DIR)/source-hashes.sha256" + @find aws.ss pssm.ss build*.ss src lib test support docs scripts .github .jerboa/security.json -type f -print | LC_ALL=C sort | xargs shasum -a 256 > "$(RELEASE_EVIDENCE_DIR)/source-hashes.sha256" @sh scripts/sanitize-evidence.sh "$(RELEASE_EVIDENCE_DIR)" @echo "Release evidence written to $(RELEASE_EVIDENCE_DIR)" --- a/README.md +++ b/README.md @@ -29,6 +29,10 @@ 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. +`jerboa-aws ssmcp` and `jerboa-aws ssm cp` recursively upload a local file or +directory through SSM RunCommand using tar/base64 chunks. Targets must already +have the SSM agent plus `sh`, `tar`, `base64`, `mkdir`, and `find`. + 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/build-all.ss +++ b/build-all.ss @@ -80,6 +80,8 @@ (jerboa-aws ssm operations) ;; PSSM (parallel SSM) (jerboa-aws pssm) + ;; SSM recursive copy + (jerboa-aws ssmcp) ;; Compute Optimizer (jerboa-aws compute-optimizer api) (jerboa-aws compute-optimizer operations) --- a/build-binary.ss +++ b/build-binary.ss @@ -148,6 +148,7 @@ ;; SSM (map (lambda (m) (format "lib/jerboa-aws/ssm/~a.so" m)) '(api operations)) + (list "lib/jerboa-aws/ssmcp.so") ;; Compute Optimizer (map (lambda (m) (format "lib/jerboa-aws/compute-optimizer/~a.so" m)) '(api operations)) --- a/src/jerboa-aws/cli/main.ss +++ b/src/jerboa-aws/cli/main.ss @@ -31,7 +31,8 @@ (jerboa-aws iam access-keys) ;; SSM (jerboa-aws ssm api) - (jerboa-aws ssm operations)) + (jerboa-aws ssm operations) + (only (jerboa-aws ssmcp) ssmcp-main)) ;; ---- Keyword argument helpers ---- @@ -213,6 +214,11 @@ (define (output-result result output-fmt) (format-output output-fmt result)) + (define (args-with-profile profile args) + (if profile + (cons "--profile" (cons profile args)) + args)) + ;; ---- Usage ---- (define (print-usage) @@ -227,6 +233,7 @@ Services: sts STS identity and session operations iam IAM users, groups, roles, policies ssm Systems Manager parameters and commands + ssmcp Recursive upload over SSM SendCommand Global options: --profile, -p NAME AWS profile name @@ -816,6 +823,8 @@ For low-level API commands use 's3api': 'document-name: doc 'comment: comment) output-fmt))) + ((string=? action "cp") + (apply ssmcp-main (args-with-profile profile args))) ((string=? action "get-command-invocation") (let ((cmd-id (or (get-opt args "--command-id") (error 'ssm "get-command-invocation requires --command-id"))) @@ -832,9 +841,11 @@ For low-level API commands use 's3api': delete-parameter --name NAME describe-instance-information send-command --instance-ids IDS --command CMD [--document-name DOC] [--comment TEXT] + cp [options] <pattern> <local-src> <remote-dest-dir> get-command-invocation --command-id ID --instance-id ID -For parallel SSM execution, use the 'pssm' command instead. +For parallel SSM execution, use the 'pssm' command. For recursive SSM upload, +use 'jerboa-aws ssm cp' or 'jerboa-aws ssmcp'. For SecureString values, --value-stdin is strongly recommended. Input is read exactly (including a trailing newline) and is limited to 8192 UTF-8 bytes. @@ -861,6 +872,10 @@ exactly (including a trailing newline) and is limited to 8192 UTF-8 bytes. (let ((service (car remaining)) (rest (cdr remaining))) + (when (string=? service "ssmcp") + (apply ssmcp-main (args-with-profile profile rest)) + (exit 0)) + ;; If no action given, show service help (when (null? rest) (cond new file mode 100644 --- /dev/null +++ b/src/jerboa-aws/ssmcp.ss @@ -0,0 +1,320 @@ +;;; (jerboa-aws ssmcp) -- recursive upload over AWS SSM SendCommand + +(export ssmcp-main + parse-ssmcp-args + ssmcp-shell-quote) +(import (chezscheme) + (jerboa-aws pssm)) + +(define SSMCP-CHUNK-SIZE 6000) + +(define (cfg-ref cfg key . default) + (hashtable-ref cfg key (if (pair? default) (car default) #f))) + +(define (cfg-ref/str cfg key) + (let ([v (cfg-ref cfg key "")]) + (if (string? v) v ""))) + +(define (put-cfg! cfg key value) + (hashtable-set! cfg key value)) + +(define (ssmcp-error message . irritants) + (display "ssmcp: " (current-error-port)) + (display (apply format message irritants) (current-error-port)) + (newline (current-error-port)) + (exit 1)) + +(define (ssmcp-shell-quote text) + (let ([out (open-output-string)]) + (put-char out #\') + (string-for-each + (lambda (ch) + (if (char=? ch #\') + (put-string out "'\"'\"'") + (put-char out ch))) + text) + (put-char out #\') + (get-output-string out))) + +(define (string-last-index text target) + (let loop ([i (- (string-length text) 1)]) + (cond + [(< i 0) #f] + [(char=? (string-ref text i) target) i] + [else (loop (- i 1))]))) + +(define (trim-trailing-slashes path) + (let loop ([n (string-length path)]) + (cond + [(<= n 1) path] + [(char=? (string-ref path (- n 1)) #\/) + (loop (- n 1))] + [(= n (string-length path)) path] + [else (substring path 0 n)]))) + +(define (path-dirname path) + (let* ([clean (trim-trailing-slashes path)] + [slash (string-last-index clean #\/)]) + (cond + [(not slash) "."] + [(= slash 0) "/"] + [else (substring clean 0 slash)]))) + +(define (path-basename path) + (let* ([clean (trim-trailing-slashes path)] + [slash (string-last-index clean #\/)]) + (if slash + (substring clean (+ slash 1) (string-length clean)) + clean))) + +(define (read-file-string path) + (call-with-input-file path + (lambda (port) (get-string-all port)))) + +(define (delete-file/quiet path) + (guard (e [#t #f]) + (delete-file path))) + +(define (system-ok? command) + (= 0 (system command))) + +(define (current-time-token) + (let ([t (current-time 'time-utc)]) + (format "~a-~a" (time-second t) (time-nanosecond t)))) + +(define (local-payload-path) + (format "/tmp/jerboa-aws-ssmcp-~a-~a.b64" + (get-process-id) + (current-time-token))) + +(define (local-tar-command source output-path) + (let ([src (trim-trailing-slashes source)]) + (if (file-directory? src) + (format "tar -C ~a -czf - . | base64 | tr -d '\\n' > ~a" + (ssmcp-shell-quote src) + (ssmcp-shell-quote output-path)) + (format "tar -C ~a -czf - ~a | base64 | tr -d '\\n' > ~a" + (ssmcp-shell-quote (path-dirname src)) + (ssmcp-shell-quote (path-basename src)) + (ssmcp-shell-quote output-path))))) + +(define (make-local-payload source) + (unless (file-exists? source) + (ssmcp-error "source does not exist: ~a" source)) + (let ([payload-path (local-payload-path)]) + (delete-file/quiet payload-path) + (let ([command (local-tar-command source payload-path)]) + (unless (system-ok? command) + (delete-file/quiet payload-path) + (ssmcp-error "failed to package source with tar/base64: ~a" source))) + (let ([payload (read-file-string payload-path)]) + (delete-file/quiet payload-path) + payload))) + +(define (split-string text chunk-size) + (let ([len (string-length text)]) + (let loop ([start 0] [chunks '()]) + (if (>= start len) + (reverse chunks) + (let ([end (min len (+ start chunk-size))]) + (loop end (cons (substring text start end) chunks))))))) + +(define (remote-payload-path) + (format "/tmp/jerboa-aws-ssmcp-~a-~a.b64" + (get-process-id) + (current-time-token))) + +(define (remote-init-command remote-tmp) + (let ([qtmp (ssmcp-shell-quote remote-tmp)]) + (format "set -eu; rm -f ~a; : > ~a; chmod 600 ~a" qtmp qtmp qtmp))) + +(define (remote-append-command remote-tmp chunk) + (format "printf %s ~a >> ~a" + (ssmcp-shell-quote chunk) + (ssmcp-shell-quote remote-tmp))) + +(define (remote-final-command remote-tmp remote-dest delete?) + (let ([qtmp (ssmcp-shell-quote remote-tmp)] + [qdest (ssmcp-shell-quote remote-dest)]) + (string-append + "set -eu; mkdir -p " qdest "; " + (if delete? + (string-append "find " qdest " -mindepth 1 -maxdepth 1 -exec rm -rf {} +; ") + "") + "base64 -d " qtmp " | tar -xzf - -C " qdest "; " + "rm -f " qtmp))) + +(define (pssm-args config command dry-run?) + (append + (if (cfg-ref config "profile") + (list "--profile" (cfg-ref/str config "profile")) + '()) + (if (cfg-ref config "timeout") + (list "--timeout" (number->string (cfg-ref config "timeout"))) + '()) + (if (cfg-ref config "poll-interval") + (list "--poll" (number->string (cfg-ref config "poll-interval"))) + '()) + (if (cfg-ref config "cache-file") + (list "--cache" (cfg-ref/str config "cache-file")) + '()) + (if (cfg-ref config "verbose") '("--verbose") '()) + (if (cfg-ref config "no-color") '("--no-color") '()) + (if (cfg-ref config "literal-controls") '("--literal-controls") '()) + (if dry-run? '("--dry-run") '()) + (list (cfg-ref/str config "pattern") command))) + +(define (run-pssm config command) + (apply pssm-main (pssm-args config command #f))) + +(define (run-pssm-dry-run config command) + (apply pssm-main (pssm-args config command #t))) + +(define (decimal-digits? text) + (and (> (string-length text) 0) + (let loop ([i 0]) + (or (= i (string-length text)) + (let ([ch (string-ref text i)]) + (and (char>=? ch #\0) + (char<=? ch #\9) + (loop (+ i 1)))))))) + +(define (decimal-string->integer text) + (let loop ([i 0] [n 0]) + (if (= i (string-length text)) + n + (let ([digit (- (char->integer (string-ref text i)) + (char->integer #\0))]) + (loop (+ i 1) (+ (* n 10) digit)))))) + +(define (parse-number-option name value) + (unless (decimal-digits? value) + (ssmcp-error "~a requires a positive decimal integer" name)) + (let ([n (decimal-string->integer value)]) + (unless (> n 0) + (ssmcp-error "~a requires a positive decimal integer" name)) + n)) + +(define (parse-ssmcp-args args) + (let ([config (make-hashtable string-hash string=?)]) + (put-cfg! config "timeout" 300) + (put-cfg! config "poll-interval" 2) + (put-cfg! config "chunk-size" SSMCP-CHUNK-SIZE) + (let loop ([rest args] [positional '()]) + (cond + [(null? rest) + (let ([pos (reverse positional)]) + (when (pair? pos) + (put-cfg! config "pattern" (car pos))) + (when (and (pair? pos) (pair? (cdr pos))) + (put-cfg! config "source" (cadr pos))) + (when (and (pair? pos) (pair? (cdr pos)) (pair? (cddr pos))) + (put-cfg! config "destination" (caddr pos))) + (put-cfg! config "extra-positional" (if (> (length pos) 3) (cdddr pos) '())) + config)] + [(or (string=? (car rest) "--help") (string=? (car rest) "-h")) + (put-cfg! config "help" #t) + (loop (cdr rest) positional)] + [(string=? (car rest) "--dry-run") + (put-cfg! config "dry-run" #t) + (loop (cdr rest) positional)] + [(string=? (car rest) "--delete") + (put-cfg! config "delete" #t) + (loop (cdr rest) positional)] + [(or (string=? (car rest) "--verbose") (string=? (car rest) "-v")) + (put-cfg! config "verbose" #t) + (loop (cdr rest) positional)] + [(string=? (car rest) "--no-color") + (put-cfg! config "no-color" #t) + (loop (cdr rest) positional)] + [(string=? (car rest) "--literal-controls") + (put-cfg! config "literal-controls" #t) + (loop (cdr rest) positional)] + [(and (or (string=? (car rest) "--profile") (string=? (car rest) "-p")) + (pair? (cdr rest))) + (put-cfg! config "profile" (cadr rest)) + (loop (cddr rest) positional)] + [(and (string=? (car rest) "--cache") (pair? (cdr rest))) + (put-cfg! config "cache-file" (cadr rest)) + (loop (cddr rest) positional)] + [(and (or (string=? (car rest) "--timeout") (string=? (car rest) "-t")) + (pair? (cdr rest))) + (put-cfg! config "timeout" (parse-number-option (car rest) (cadr rest))) + (loop (cddr rest) positional)] + [(and (string=? (car rest) "--poll") (pair? (cdr rest))) + (put-cfg! config "poll-interval" (parse-number-option "--poll" (cadr rest))) + (loop (cddr rest) positional)] + [(and (string=? (car rest) "--chunk-size") (pair? (cdr rest))) + (put-cfg! config "chunk-size" (parse-number-option "--chunk-size" (cadr rest))) + (loop (cddr rest) positional)] + [else + (loop (cdr rest) (cons (car rest) positional))])))) + +(define (print-ssmcp-usage) + (display "ssmcp - recursive upload over AWS SSM SendCommand + +Usage: ssmcp [options] <pattern> <local-src> <remote-dest-dir> + +Copies a local file or directory to every cached EC2 instance whose Name tag +matches <pattern>. The transfer uses SSM RunCommand, so targets need a running +SSM agent and shell tools: tar, base64, mkdir, and find. + +Examples: + ssmcp 'web-*' ./site /opt/site + ssmcp --delete 'app-*' ./config /etc/myapp + ssmcp -p prod --timeout 600 'batch-*' ./scripts /tmp/scripts + +Options: + -p, --profile NAME AWS profile name + -t, --timeout SECS Per-command timeout in seconds (default: 300) + --poll SECS Poll interval in seconds (default: 2) + --cache PATH EC2 cache file (default from pssm) + --chunk-size N Base64 chars per SSM command chunk (default: 6000) + --delete Delete remote destination contents before extract + --dry-run Show target command without sending payload + -v, --verbose Verbose pssm output + --no-color Disable ANSI colors + --literal-controls Show remote control bytes as visible \\xNN text + -h, --help Show this help +")) + +(define (validate-ssmcp-config config) + (when (cfg-ref config "help") + (print-ssmcp-usage) + (exit 0)) + (unless (cfg-ref config "pattern") + (print-ssmcp-usage) + (ssmcp-error "missing pattern")) + (unless (cfg-ref config "source") + (print-ssmcp-usage) + (ssmcp-error "missing local source")) + (unless (cfg-ref config "destination") + (print-ssmcp-usage) + (ssmcp-error "missing remote destination directory")) + (when (pair? (cfg-ref config "extra-positional")) + (ssmcp-error "too many positional arguments"))) + +(define (ssmcp-main . args) + (let ([config (parse-ssmcp-args args)]) + (validate-ssmcp-config config) + (let* ([source (cfg-ref/str config "source")] + [dest (cfg-ref/str config "destination")] + [remote-tmp (remote-payload-path)] + [chunk-size (cfg-ref config "chunk-size")]) + (if (cfg-ref config "dry-run") + (begin + (display (format "ssmcp dry-run: would upload ~a to ~a\n" source dest)) + (run-pssm-dry-run config (remote-final-command remote-tmp dest (cfg-ref config "delete")))) + (let* ([payload (make-local-payload source)] + [chunks (split-string payload chunk-size)]) + (display (format "ssmcp: uploading ~a chunk~a to ~a\n" + (length chunks) + (if (= (length chunks) 1) "" "s") + (cfg-ref/str config "pattern"))) + (run-pssm config (remote-init-command remote-tmp)) + (for-each + (lambda (chunk) + (run-pssm config (remote-append-command remote-tmp chunk))) + chunks) + (run-pssm config (remote-final-command remote-tmp dest (cfg-ref config "delete"))) + (display "ssmcp: done\n")))))) --- a/test/test-all.ss +++ b/test/test-all.ss @@ -10,6 +10,9 @@ pssm-terminal-sanitize pssm-terminal-literal pssm-render-host-result) + (only (jerboa-aws ssmcp) + parse-ssmcp-args + ssmcp-shell-quote) (only (jerboa-aws cli main) resolve-ssm-parameter-value)) @@ -296,6 +299,22 @@ (check "PSSM parses --literal-controls" (hashtable-ref config "literal-controls" #f) #t)) +(let ([config (parse-ssmcp-args + '("--delete" "--chunk-size" "4096" "web-*" "./site" "/opt/site"))]) + (check "SSMCP parses pattern" + (hashtable-ref config "pattern" #f) "web-*") + (check "SSMCP parses source" + (hashtable-ref config "source" #f) "./site") + (check "SSMCP parses destination" + (hashtable-ref config "destination" #f) "/opt/site") + (check "SSMCP parses --delete" + (hashtable-ref config "delete" #f) #t) + (check "SSMCP parses --chunk-size" + (hashtable-ref config "chunk-size" #f) 4096)) + +(check "SSMCP shell quote escapes single quotes" + (ssmcp-shell-quote "a'b") "'a'\"'\"'b'") + (define hostile-result (make-hashtable string-hash string=?)) (hashtable-set! hostile-result "name" (string-append "host" (string esc-char) "]0;fake" (string bel-char)))