Add AWS EC2 SSH mode with tabulated-list infrastructure and fix static build
ober
9e4c3a5747838a7d78e940583266ec67f49c99ba
--- a/Makefile +++ b/Makefile @@ -293,6 +293,7 @@ CHEZ_MT ?= ta6le CHEZ_MUSL_DIR ?= $(shell ls -d /opt/chez/lib/csv*/$(CHEZ_MT) 2>/dev/null | head -1) build-jemacs-qt-static: check-root + rm -f /src/src/.jerbuild-hashes; \ cp /src/vendor/jerboa-shell/embed-crypto.c /deps/jsh/ 2>/dev/null; \ cp /src/vendor/jerboa-shell/embed-crypto.h /deps/jsh/ 2>/dev/null; \ cp /src/vendor/jerboa-shell/ffi-shim.c /deps/jsh/ 2>/dev/null; \ @@ -387,42 +388,24 @@ linux-static-qt-docker: --ulimit nofile=8192:8192 \ -v $(CURDIR):/src:z \ -v $(JERBOA)/lib/std:/host-jerboa-std:ro \ + -v $(JERBOA)/lib/jerboa:/host-jerboa-core:ro \ -v $(JSH_SRC)/src:/host-jsh-src:ro \ -v $(JSH_COREUTILS_LIB):/host-jsh-coreutils.a:ro \ $(DEPS_IMAGE) \ sh -c "apk add --no-cache libvterm-dev libvterm-static >/dev/null 2>&1; \ cp /host-jsh-coreutils.a /deps/jsh/libjsh_coreutils.a; \ cp -a /host-jsh-src/. /deps/jsh/src/; \ - for f in \ - misc/atom.sls misc/channel.sls misc/completion.sls misc/list.sls \ - misc/memo.sls misc/number.sls misc/ports.sls misc/process.sls \ - misc/rwlock.sls misc/shuffle.sls misc/string.sls misc/terminal.sls \ - cli/getopt.sls \ - net/request.sls net/uri.sls \ - os/fdio.sls os/signal.sls os/tty.sls os/sandbox.sls \ - text/base64.sls text/diff.sls text/glob.sls text/hex.sls text/json.sls \ - crypto/digest.sls \ - engine.sls fiber.sls guardian.sls select.sls stm.sls task.sls \ - amb.sls \ - misc/thread.sls misc/wg.sls misc/pqueue.sls misc/lru-cache.sls \ - misc/channel.sls misc/atom.sls misc/rbtree.sls \ - misc/rwlock.sls misc/completion.sls misc/barrier.sls \ - result.sls misc/result.sls misc/fmt.sls \ - misc/custodian.sls misc/config.sls misc/memoize.sls \ - misc/terminal.sls misc/trie.sls \ - actor/mpsc.sls actor/core.sls actor/transport.sls \ - crypto/random.sls \ - format.sls iter.sls pregexp.sls sort.sls sugar.sls \ - srfi/srfi-1.sls srfi/srfi-13.sls srfi/srfi-19.sls; do \ - if [ -f /host-jerboa-std/\$$f ]; then \ - mkdir -p /deps/jerboa/lib/std/$$(dirname \$$f); \ - cp /host-jerboa-std/\$$f /deps/jerboa/lib/std/\$$f; \ - rm -f /deps/jerboa/lib/std/\$${f%.sls}.so /deps/jerboa/lib/std/\$${f%.sls}.wpo; \ - echo SYNC: \$$f; \ - else \ - echo SKIP: \$$f not found on host; \ - fi; \ - done; \ + echo 'SYNC: bulk-copying host jerboa std/ and jerboa/ into container...'; \ + cp -a /host-jerboa-std/. /deps/jerboa/lib/std/ && \ + cp -a /host-jerboa-core/. /deps/jerboa/lib/jerboa/ && \ + find /deps/jerboa/lib -name '*.so' -delete && \ + find /deps/jerboa/lib -name '*.wpo' -delete && \ + echo '(import (chezscheme)) (compile-imported-libraries #t) (import (jerboa core)) (import (jerboa prelude))' \ + > /tmp/compile-jerboa-core.ss && \ + cd /deps/jerboa/lib && /opt/chez/bin/scheme --libdirs /deps/jerboa/lib \ + -q --script /tmp/compile-jerboa-core.ss && \ + rm -f /deps/jerboa/lib/jerboa/*.wpo && \ + echo 'COMPILED: jerboa core + prelude'; \ chmod 755 /root && \ chown -R $(UID):$(GID) /opt/ /deps && \ mkdir -p /tmp/jemacs-build && chown $(UID):$(GID) /tmp/jemacs-build && \ --- a/build-binary-qt.ss +++ b/build-binary-qt.ss @@ -170,6 +170,9 @@ "std/misc/terminal" "std/misc/trie" "std/misc/lru-cache" + "std/misc/ports" + "std/srfi/srfi-13" + "std/text/json" "std/actor/mpsc" "std/actor/core" "std/actor/transport" @@ -178,9 +181,13 @@ "std/os/sandbox" "std/os/landlock" "std/security/capsicum")) - ;; Jerboa core + sugar + repl + ;; Jerboa core + sugar + repl + dependencies + ;; std/typed: jerboa/core imports it + ;; std/result: std/sugar imports it (map (lambda (m) (format "~a/~a.so" jerboa-dir m)) - '("jerboa/core" + '("std/result" + "std/typed" + "jerboa/core" "std/sugar" "std/repl")) ;; std/net/tcp and std/net/uri (compiled by step 1) @@ -409,7 +416,8 @@ sort -u | grep -v '^$' | grep -v '^_NSGetExecutablePath$' | grep -v '^io_uring_' grep -v '^jerboa_' | grep -v '^SSL_' | grep -v '^TLS_' | grep -v '^EVP_' | \ grep -v '^CRYPTO_' | grep -v '^PKCS5_' | grep -v '^RAND_' | \ grep -v '^QRcode_' | grep -v '^embed_encrypt$' | grep -v '^embed_random_bytes$' | \ -grep -v '^kqueue$' | grep -v '^kevent$' | grep -v '^sandbox_' > /tmp/ffi_syms.txt && \ +grep -v '^kqueue$' | grep -v '^kevent$' | grep -v '^sandbox_' | \ +grep -v '^__error$' > /tmp/ffi_syms.txt && \ awk '\ BEGIN{ print \"/* Auto-generated — do not edit */\"; \ print \"#include \\\"scheme.h\\\"\"; print \"\"; } \ --- a/lib/jerboa-emacs/async.sls +++ b/lib/jerboa-emacs/async.sls @@ -552,8 +552,8 @@ (let ([v (hashtable-ref cache key - '#{miss ggxha04xz6hyzrhna9yglgxud-0})]) - (if (eq? v '#{miss ggxha04xz6hyzrhna9yglgxud-1}) + '#{miss gxqbd0sajiqb4war1wkachpqo-1})]) + (if (eq? v '#{miss gxqbd0sajiqb4war1wkachpqo-2}) (if (null? default) #f (car default)) v))) (def (weak-cache-set! cache key value) new file mode 100644 --- /dev/null +++ b/lib/jerboa-emacs/qt/commands-aws.sls @@ -0,0 +1,405 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jerboa-emacs/qt/commands-aws.ss + +(library (jerboa-emacs qt commands-aws) + (export cmd-aws-ec2-ssh cmd-aws-ec2-ssh-connect + cmd-aws-ec2-ssh-refresh cmd-aws-ec2-ssh-force-refresh + cmd-aws-ec2-ssh-filter cmd-aws-ec2-ssh-clear-filter + cmd-aws-ec2-ssh-sort-name cmd-aws-ec2-ssh-sort-region + aws-ec2-ssh-setup-mode!) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name sort sort!) + (std sugar) (std sort) (std srfi srfi-13) + (only (std misc string) string-empty?) + (only (std misc ports) read-file-lines) (std text json) + (chez-scintilla constants) (jerboa-emacs core) + (jerboa-emacs buffer) (jerboa-emacs tabulated-list) + (jerboa-emacs terminal) (jerboa-emacs async) + (jerboa-emacs echo) (jerboa-emacs qt buffer) + (jerboa-emacs qt window) (jerboa-emacs qt sci-shim) + (jerboa-emacs qt echo) (jerboa-emacs qt commands-core) + (jerboa core) (jerboa runtime)) + (def *aws-ec2-ssh-config-file* "~/.aws-custom-ssh.yaml") + (def *aws-ec2-ssh-cache-ttl* 300) + (def *aws-ec2-ssh-user* #f) + (def *aws-ec2-ssh-common-regions* + '("us-east-1" "us-east-2" "us-west-1" "us-west-2" "eu-west-1" "eu-west-2" + "eu-west-3" "eu-central-1" "eu-north-1" "ap-northeast-1" + "ap-northeast-2" "ap-southeast-1" "ap-southeast-2" + "ap-south-1" "sa-east-1" "ca-central-1")) + (def *aws-region-domain-map* '()) + (def *aws-cache* #f) + (def *aws-cache-expiry* 0) + (def *aws-columns* + (list (make-tl-column "Name" 25) (make-tl-column "State" 10) + (make-tl-column "Type" 14) (make-tl-column "Private IP" 16) + (make-tl-column "Region" 14) + (make-tl-column "SSH Target" 40))) + (def (aws-load-config!) + "Load region->domain mappings from config file." + (let ([path (path-expand *aws-ec2-ssh-config-file*)]) + (if (file-exists? path) + (begin + (set! *aws-region-domain-map* + (with-catch + (lambda (e) '()) + (lambda () + (let ([lines (read-file-lines path)]) + (filter-map + (lambda (line) + (let ([trimmed (string-trim line)]) + (and (> (string-length trimmed) 0) + (not (string-prefix? "#" trimmed)) + (string-contains trimmed ":") + (let* ([idx (string-contains + trimmed + ":")] + [key (string-trim + (substring trimmed 0 idx))] + [val (string-trim + (substring + trimmed + (+ idx 1) + (string-length + trimmed)))]) + (and (> (string-length key) 0) + (> (string-length val) 0) + (cons key val)))))) + lines))))) + (length *aws-region-domain-map*)) + (begin (set! *aws-region-domain-map* '()) 0)))) + (def (aws-get-domain region) + "Get domain suffix for REGION from config, or #f." + (let ([pair (assoc region *aws-region-domain-map*)]) + (and pair (cdr pair)))) + (def (aws-cache-valid?) + (and *aws-cache* + (> *aws-cache-expiry* (time-second (current-time))))) + (def (aws-cache-put! instances) + (set! *aws-cache* instances) + (set! *aws-cache-expiry* + (+ (time-second (current-time)) *aws-ec2-ssh-cache-ttl*))) + (def (aws-cache-clear!) + (set! *aws-cache* #f) + (set! *aws-cache-expiry* 0)) + (def (aws-fetch-region-cmd region) + "Build aws CLI command string for a region." + (string-append + "aws ec2 describe-instances --region " + region + " --output json --no-cli-pager 2>/dev/null")) + (def (aws-parse-instances json-str region) + "Parse AWS JSON output into a list of instance alists.\n Each instance gets an extra '_region' key." + (with-catch + (lambda (e) '()) + (lambda () + (let* ([data (string->json-object json-str)] + [reservations (or (hash-ref data "Reservations" #f) + '())]) + (apply + append + (map (lambda (r) + (let ([instances (or (hash-ref r "Instances" #f) + '())]) + (map (lambda (inst) + (hash-put! inst "_region" region) + inst) + instances))) + reservations)))))) + (def (aws-instance-name inst) + "Get the Name tag from an instance hash, or empty string." + (let ([tags (or (hash-ref inst "Tags" #f) '())]) + (let loop ([ts tags]) + (if (null? ts) + "" + (let ([tag (car ts)]) + (if (and (hash-ref tag "Key" #f) + (string=? (hash-ref tag "Key" "") "Name")) + (or (hash-ref tag "Value" #f) "") + (loop (cdr ts)))))))) + (def (aws-instance-state inst) + "Get the state name (running, stopped, etc.)." + (let ([state (hash-ref inst "State" #f)]) + (if state (or (hash-ref state "Name" #f) "-") "-"))) + (def (aws-instance->entry inst) + "Convert an AWS instance hash to a tabulated-list entry: (cons id (vector ...))." + (let* ([id (or (hash-ref inst "InstanceId" #f) "")] + [name (aws-instance-name inst)] + [state (aws-instance-state inst)] + [type (or (hash-ref inst "InstanceType" #f) "-")] + [ip (or (hash-ref inst "PrivateIpAddress" #f) "-")] + [region (or (hash-ref inst "_region" #f) "-")] + [domain (aws-get-domain region)] + [ssh-target (if (and (> (string-length name) 0) domain) + (string-append name "." domain) + "-")]) + (cons id (vector name state type ip region ssh-target)))) + (def *aws-pending-regions* 0) + (def *aws-pending-instances* '()) + (def *aws-pending-errors* 0) + (def *aws-pending-callback* #f) + (def (aws-fetch-all-regions! callback) + "Fetch instances from all configured regions asynchronously.\n Calls CALLBACK with the merged instance list when all regions complete." + (let ([regions *aws-ec2-ssh-common-regions*]) + (set! *aws-pending-regions* (length regions)) + (set! *aws-pending-instances* '()) + (set! *aws-pending-errors* 0) + (set! *aws-pending-callback* callback) + (for-each + (lambda (region) + (async-process! (aws-fetch-region-cmd region) 'callback: + (lambda (output) + (let ([instances (aws-parse-instances output region)]) + (let ([running (filter + (lambda (inst) + (string=? + (aws-instance-state inst) + "running")) + instances)]) + (set! *aws-pending-instances* + (append *aws-pending-instances* running)))) + (set! *aws-pending-regions* (- *aws-pending-regions* 1)) + (aws-check-fetch-complete!)) + 'on-error: + (lambda (e) + (set! *aws-pending-errors* (+ *aws-pending-errors* 1)) + (set! *aws-pending-regions* (- *aws-pending-regions* 1)) + (aws-check-fetch-complete!)))) + regions))) + (def (aws-check-fetch-complete!) + "Check if all region fetches are done." + (when (= *aws-pending-regions* 0) + (let ([instances *aws-pending-instances*] + [cb *aws-pending-callback*]) + (aws-cache-put! instances) + (when cb (cb instances))))) + (def (aws-ec2-ssh-setup-mode!) + "Register the AWS EC2 SSH mode keymap and buffer-name mapping." + (hash-put! + *buffer-name-mode-map* + "*AWS EC2 SSH*" + 'aws-ec2-ssh) + (let ([km (make-keymap)]) + (for-each + (lambda (p) (keymap-bind! km (car p) (cdr p))) + '(("n" . next-line) ("p" . previous-line) ("RET" . aws-ec2-ssh-connect) + ("g" . aws-ec2-ssh-refresh) + ("G" . aws-ec2-ssh-force-refresh) ("/" . aws-ec2-ssh-filter) + ("C" . aws-ec2-ssh-clear-filter) + ("s" . aws-ec2-ssh-sort-name) + ("S" . aws-ec2-ssh-sort-region) ("q" . kill-buffer-cmd))) + (mode-keymap-set! 'aws-ec2-ssh km))) + (def (aws-refresh-buffer! app instances) + "Populate the *AWS EC2 SSH* buffer with instance data." + (let* ([buf (buffer-by-name "*AWS EC2 SSH*")] + [ed (current-qt-editor app)] + [fr (app-state-frame app)]) + (when buf + (let* ([entries (map aws-instance->entry instances)] + [sorted (sort + (lambda (a b) + (string<? + (vector-ref (cdr a) 0) + (vector-ref (cdr b) 0))) + entries)]) + (tabulated-list-set-entries! buf sorted) + (let ([text (tabulated-list-refresh! buf)]) + (when text + (sci-send ed SCI_SETREADONLY 0) + (qt-plain-text-edit-set-text! ed text) + (qt-text-document-set-modified! + (buffer-doc-pointer buf) + #f) + (sci-send ed SCI_SETREADONLY 1) + (let ([pos (sci-send + ed + SCI_POSITIONFROMLINE + tabulated-list-header-lines + 0)]) + (qt-plain-text-edit-set-cursor-position! ed pos)) + (sci-send + ed + SCI_SETCARETLINEBACK + (rgb->sci 42 42 74)))))))) + (def (aws-re-render! app) + "Re-render the current tabulated list state (after filter/sort change)." + (let* ([buf (buffer-by-name "*AWS EC2 SSH*")] + [ed (current-qt-editor app)] + [line (qt-plain-text-edit-cursor-line ed)]) + (when buf + (let ([text (tabulated-list-refresh! buf)]) + (when text + (sci-send ed SCI_SETREADONLY 0) + (qt-plain-text-edit-set-text! ed text) + (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) + (sci-send ed SCI_SETREADONLY 1) + (let* ([count (tabulated-list-entry-count buf)] + [max-line (+ tabulated-list-header-lines + (max 0 (- count 1)))] + [target (min line max-line)] + [pos (sci-send + ed + SCI_POSITIONFROMLINE + (max target tabulated-list-header-lines) + 0)]) + (qt-plain-text-edit-set-cursor-position! ed pos))))))) + (def (cmd-aws-ec2-ssh app) + "Browse EC2 instances and SSH to them.\nM-x aws-ec2-ssh\nKeys: n/p=navigate, RET=ssh, g=refresh, G=force-refresh, /=filter, q=quit" + (let* ([config-count (aws-load-config!)] + [fr (app-state-frame app)] + [ed (current-qt-editor app)] + [echo (app-state-echo app)] + [buf-name "*AWS EC2 SSH*"] + [buf (or (buffer-by-name buf-name) + (qt-buffer-create! buf-name ed #f))]) + (qt-buffer-attach! ed buf) + (qt-edit-window-buffer-set! (qt-current-window fr) buf) + (unless (tabulated-list-get-state buf) + (tabulated-list-init! buf *aws-columns*)) + (sci-send ed SCI_SETREADONLY 0) + (qt-plain-text-edit-set-text! + ed + " Fetching EC2 instances...") + (sci-send ed SCI_SETREADONLY 1) + (if (aws-cache-valid?) + (begin + (aws-refresh-buffer! app *aws-cache*) + (echo-message! + echo + (string-append + "Loaded " + (number->string (length *aws-cache*)) + " instances from cache"))) + (begin + (echo-message! + echo + (string-append + "Fetching instances from " + (number->string (length *aws-ec2-ssh-common-regions*)) + " regions...")) + (aws-fetch-all-regions! + (lambda (instances) + (aws-refresh-buffer! app instances) + (echo-message! + echo + (string-append "Loaded " (number->string (length instances)) + " running instances from " + (number->string + (length *aws-ec2-ssh-common-regions*)) + " regions")))))))) + (def (cmd-aws-ec2-ssh-refresh app) + "Refresh instance list (uses cache if valid)." + (let ([echo (app-state-echo app)]) + (if (aws-cache-valid?) + (begin + (aws-refresh-buffer! app *aws-cache*) + (echo-message! echo "Refreshed from cache")) + (begin + (echo-message! echo "Fetching instances...") + (aws-fetch-all-regions! + (lambda (instances) + (aws-refresh-buffer! app instances) + (echo-message! + echo + (string-append + "Loaded " + (number->string (length instances)) + " instances")))))))) + (def (cmd-aws-ec2-ssh-force-refresh app) + "Force refresh instance list (bypass cache)." + (aws-cache-clear!) + (let ([echo (app-state-echo app)]) + (echo-message! echo "Force fetching instances...") + (aws-fetch-all-regions! + (lambda (instances) + (aws-refresh-buffer! app instances) + (echo-message! + echo + (string-append + "Loaded " + (number->string (length instances)) + " instances")))))) + (def (cmd-aws-ec2-ssh-connect app) + "SSH to the instance at point.\nOpens a terminal buffer and types the SSH command, then executes it." + (let* ([buf (current-qt-buffer app)] + [ed (current-qt-editor app)] + [echo (app-state-echo app)] + [line (qt-plain-text-edit-cursor-line ed)] + [entry (tabulated-list-get-entry-at-line buf line)]) + (if (not entry) + (echo-message! echo "No instance on this line") + (let* ([vals (cdr entry)] + [name (vector-ref vals 0)] + [state (vector-ref vals 1)] + [ssh-target (vector-ref vals 5)]) + (cond + [(string-empty? name) + (echo-message! echo "Instance has no Name tag")] + [(not (string=? state "running")) + (echo-message! + echo + (string-append + "Instance is not running (state: " + state + ")"))] + [(string=? ssh-target "-") + (echo-message! + echo + "No SSH target configured for this region")] + [else + (let ([ssh-cmd (if *aws-ec2-ssh-user* + (string-append + "ssh " + *aws-ec2-ssh-user* + "@" + ssh-target) + (string-append "ssh " ssh-target))]) + (execute-command! app 'term) + (let* ([term-ed (current-qt-editor app)] + [term-buf (current-qt-buffer app)] + [ts (and term-buf + (hash-get *terminal-state* term-buf))]) + (when ts + (qt-plain-text-edit-move-cursor! + term-ed + QT_CURSOR_END) + (qt-plain-text-edit-insert-text! term-ed ssh-cmd) + (execute-command! app 'terminal-send) + (echo-message! + echo + (string-append "SSH: " ssh-target)))))]))))) + (def (cmd-aws-ec2-ssh-filter app) + "Filter instances by string." + (let* ([buf (current-qt-buffer app)] + [query (qt-echo-read-string app "Filter: ")]) + (when query + (tabulated-list-filter! buf query) + (aws-re-render! app) + (echo-message! + (app-state-echo app) + (if (string-empty? query) + "Filter cleared" + (string-append "Filter: " query " (" + (number->string (tabulated-list-entry-count buf)) + " matches)")))))) + (def (cmd-aws-ec2-ssh-clear-filter app) + "Clear the instance filter." + (let ([buf (current-qt-buffer app)]) + (tabulated-list-clear-filter! buf) + (aws-re-render! app) + (echo-message! (app-state-echo app) "Filter cleared"))) + (def (cmd-aws-ec2-ssh-sort-name app) + "Sort instances by name." + (let ([buf (current-qt-buffer app)]) + (tabulated-list-sort! buf 0) + (aws-re-render! app) + (echo-message! (app-state-echo app) "Sorted by name"))) + (def (cmd-aws-ec2-ssh-sort-region app) + "Sort instances by region." + (let ([buf (current-qt-buffer app)]) + (tabulated-list-sort! buf 4) + (aws-re-render! app) + (echo-message! (app-state-echo app) "Sorted by region")))) --- a/lib/jerboa-emacs/qt/commands.sls +++ b/lib/jerboa-emacs/qt/commands.sls @@ -95,6 +95,7 @@ (jerboa-emacs qt commands-parity5) (jerboa-emacs qt commands-aliases) (jerboa-emacs qt commands-aliases2) + (jerboa-emacs qt commands-aws) (except (jerboa-emacs helm-commands) cmd-helm-buffers-list @@ -2217,7 +2218,29 @@ (qt-register-parity3-toggles!) (qt-register-parity4-commands!) (qt-register-parity4-toggles!) - (qt-register-parity5-commands!) + (qt-register-parity5-commands!) (aws-ec2-ssh-setup-mode!) + (register-command! 'aws-ec2-ssh cmd-aws-ec2-ssh) + (register-command! + 'aws-ec2-ssh-connect + cmd-aws-ec2-ssh-connect) + (register-command! + 'aws-ec2-ssh-refresh + cmd-aws-ec2-ssh-refresh) + (register-command! + 'aws-ec2-ssh-force-refresh + cmd-aws-ec2-ssh-force-refresh) + (register-command! + 'aws-ec2-ssh-filter + cmd-aws-ec2-ssh-filter) + (register-command! + 'aws-ec2-ssh-clear-filter + cmd-aws-ec2-ssh-clear-filter) + (register-command! + 'aws-ec2-ssh-sort-name + cmd-aws-ec2-ssh-sort-name) + (register-command! + 'aws-ec2-ssh-sort-region + cmd-aws-ec2-ssh-sort-region) (set-box! *modeline-overwrite-provider* (lambda () *overwrite-mode*)) new file mode 100644 --- /dev/null +++ b/src/jerboa-emacs/qt/commands-aws.ss @@ -0,0 +1,457 @@ +;;; -*- Gerbil -*- +;;; commands-aws.ss — AWS EC2 SSH mode for jemacs +;;; +;;; Emacs-like tabulated-list mode: browse EC2 instances across regions, +;;; filter/sort, and SSH into them via a terminal buffer. +;;; +;;; M-x aws-ec2-ssh — Open the instance list +;;; +;;; Key bindings (in *AWS EC2 SSH* buffer): +;;; n/p — Next/previous line +;;; RET — SSH to instance (opens terminal) +;;; g — Refresh (uses cache) +;;; G — Force refresh (bypass cache) +;;; / — Filter by string +;;; C — Clear filter +;;; s — Sort by name +;;; S — Sort by region +;;; q — Quit + +(export + cmd-aws-ec2-ssh + cmd-aws-ec2-ssh-connect + cmd-aws-ec2-ssh-refresh + cmd-aws-ec2-ssh-force-refresh + cmd-aws-ec2-ssh-filter + cmd-aws-ec2-ssh-clear-filter + cmd-aws-ec2-ssh-sort-name + cmd-aws-ec2-ssh-sort-region + aws-ec2-ssh-setup-mode!) + +(import + :std/sugar + :std/sort + :std/srfi/13 + (only-in :std/misc/string string-empty?) + (only-in :std/misc/ports read-file-lines) + :std/text/json + :chez-scintilla/constants + :jerboa-emacs/core + :jerboa-emacs/buffer + :jerboa-emacs/tabulated-list + :jerboa-emacs/terminal + :jerboa-emacs/async + :jerboa-emacs/echo + :jerboa-emacs/qt/buffer + :jerboa-emacs/qt/window + :jerboa-emacs/qt/sci-shim + :jerboa-emacs/qt/echo + :jerboa-emacs/qt/commands-core) + +;;; ============================================================================ +;;; Configuration +;;; ============================================================================ + +(def *aws-ec2-ssh-config-file* "~/.aws-custom-ssh.yaml") +(def *aws-ec2-ssh-cache-ttl* 300) ;; seconds +(def *aws-ec2-ssh-user* #f) ;; SSH user, or #f for default + +(def *aws-ec2-ssh-common-regions* + '("us-east-1" "us-east-2" "us-west-1" "us-west-2" + "eu-west-1" "eu-west-2" "eu-west-3" "eu-central-1" "eu-north-1" + "ap-northeast-1" "ap-northeast-2" "ap-southeast-1" "ap-southeast-2" + "ap-south-1" "sa-east-1" "ca-central-1")) + +;;; ============================================================================ +;;; Internal state +;;; ============================================================================ + +(def *aws-region-domain-map* '()) ;; alist: region -> domain +(def *aws-cache* #f) ;; cached instance list +(def *aws-cache-expiry* 0) ;; epoch seconds + +;; Columns for the tabulated list +(def *aws-columns* + (list (make-tl-column "Name" 25) + (make-tl-column "State" 10) + (make-tl-column "Type" 14) + (make-tl-column "Private IP" 16) + (make-tl-column "Region" 14) + (make-tl-column "SSH Target" 40))) + +;;; ============================================================================ +;;; Config file parsing (simple YAML: "key: value" per line) +;;; ============================================================================ + +(def (aws-load-config!) + "Load region->domain mappings from config file." + (let ((path (path-expand *aws-ec2-ssh-config-file*))) + (if (file-exists? path) + (begin + (set! *aws-region-domain-map* + (with-catch + (lambda (e) '()) + (lambda () + (let ((lines (read-file-lines path))) + (filter-map + (lambda (line) + (let ((trimmed (string-trim line))) + (and (> (string-length trimmed) 0) + (not (string-prefix? "#" trimmed)) + (string-contains trimmed ":") + (let* ((idx (string-contains trimmed ":")) + (key (string-trim (substring trimmed 0 idx))) + (val (string-trim (substring trimmed (+ idx 1) + (string-length trimmed))))) + (and (> (string-length key) 0) + (> (string-length val) 0) + (cons key val)))))) + lines))))) + (length *aws-region-domain-map*)) + (begin + (set! *aws-region-domain-map* '()) + 0)))) + +(def (aws-get-domain region) + "Get domain suffix for REGION from config, or #f." + (let ((pair (assoc region *aws-region-domain-map*))) + (and pair (cdr pair)))) + +;;; ============================================================================ +;;; Cache +;;; ============================================================================ + +(def (aws-cache-valid?) + (and *aws-cache* + (> *aws-cache-expiry* (time-second (current-time))))) + +(def (aws-cache-put! instances) + (set! *aws-cache* instances) + (set! *aws-cache-expiry* (+ (time-second (current-time)) *aws-ec2-ssh-cache-ttl*))) + +(def (aws-cache-clear!) + (set! *aws-cache* #f) + (set! *aws-cache-expiry* 0)) + +;;; ============================================================================ +;;; AWS CLI — fetch instances from one region +;;; ============================================================================ + +(def (aws-fetch-region-cmd region) + "Build aws CLI command string for a region." + (string-append "aws ec2 describe-instances --region " region + " --output json --no-cli-pager 2>/dev/null")) + +(def (aws-parse-instances json-str region) + "Parse AWS JSON output into a list of instance alists. + Each instance gets an extra '_region' key." + (with-catch + (lambda (e) '()) + (lambda () + (let* ((data (string->json-object json-str)) + (reservations (or (hash-ref data "Reservations" #f) '()))) + (apply append + (map (lambda (r) + (let ((instances (or (hash-ref r "Instances" #f) '()))) + (map (lambda (inst) + (hash-put! inst "_region" region) + inst) + instances))) + reservations)))))) + +(def (aws-instance-name inst) + "Get the Name tag from an instance hash, or empty string." + (let ((tags (or (hash-ref inst "Tags" #f) '()))) + (let loop ((ts tags)) + (if (null? ts) "" + (let ((tag (car ts))) + (if (and (hash-ref tag "Key" #f) + (string=? (hash-ref tag "Key" "") "Name")) + (or (hash-ref tag "Value" #f) "") + (loop (cdr ts)))))))) + +(def (aws-instance-state inst) + "Get the state name (running, stopped, etc.)." + (let ((state (hash-ref inst "State" #f))) + (if state (or (hash-ref state "Name" #f) "-") "-"))) + +(def (aws-instance->entry inst) + "Convert an AWS instance hash to a tabulated-list entry: (cons id (vector ...))." + (let* ((id (or (hash-ref inst "InstanceId" #f) "")) + (name (aws-instance-name inst)) + (state (aws-instance-state inst)) + (type (or (hash-ref inst "InstanceType" #f) "-")) + (ip (or (hash-ref inst "PrivateIpAddress" #f) "-")) + (region (or (hash-ref inst "_region" #f) "-")) + (domain (aws-get-domain region)) + (ssh-target (if (and (> (string-length name) 0) domain) + (string-append name "." domain) + "-"))) + (cons id (vector name state type ip region ssh-target)))) + +;;; ============================================================================ +;;; Multi-region async fetch +;;; ============================================================================ + +(def *aws-pending-regions* 0) +(def *aws-pending-instances* '()) +(def *aws-pending-errors* 0) +(def *aws-pending-callback* #f) + +(def (aws-fetch-all-regions! callback) + "Fetch instances from all configured regions asynchronously. + Calls CALLBACK with the merged instance list when all regions complete." + (let ((regions *aws-ec2-ssh-common-regions*)) + (set! *aws-pending-regions* (length regions)) + (set! *aws-pending-instances* '()) + (set! *aws-pending-errors* 0) + (set! *aws-pending-callback* callback) + (for-each + (lambda (region) + (async-process! + (aws-fetch-region-cmd region) + callback: + (lambda (output) + (let ((instances (aws-parse-instances output region))) + ;; Filter to running only + (let ((running (filter + (lambda (inst) + (string=? (aws-instance-state inst) "running")) + instances))) + (set! *aws-pending-instances* + (append *aws-pending-instances* running)))) + (set! *aws-pending-regions* (- *aws-pending-regions* 1)) + (aws-check-fetch-complete!)) + on-error: + (lambda (e) + (set! *aws-pending-errors* (+ *aws-pending-errors* 1)) + (set! *aws-pending-regions* (- *aws-pending-regions* 1)) + (aws-check-fetch-complete!)))) + regions))) + +(def (aws-check-fetch-complete!) + "Check if all region fetches are done." + (when (= *aws-pending-regions* 0) + (let ((instances *aws-pending-instances*) + (cb *aws-pending-callback*)) + (aws-cache-put! instances) + (when cb (cb instances))))) + +;;; ============================================================================ +;;; Mode keymap setup +;;; ============================================================================ + +(def (aws-ec2-ssh-setup-mode!) + "Register the AWS EC2 SSH mode keymap and buffer-name mapping." + ;; Register buffer name -> mode mapping + (hash-put! *buffer-name-mode-map* "*AWS EC2 SSH*" 'aws-ec2-ssh) + ;; Create and register mode keymap + (let ((km (make-keymap))) + (for-each (lambda (p) (keymap-bind! km (car p) (cdr p))) + '(("n" . next-line) + ("p" . previous-line) + ("RET" . aws-ec2-ssh-connect) + ("g" . aws-ec2-ssh-refresh) + ("G" . aws-ec2-ssh-force-refresh) + ("/" . aws-ec2-ssh-filter) + ("C" . aws-ec2-ssh-clear-filter) + ("s" . aws-ec2-ssh-sort-name) + ("S" . aws-ec2-ssh-sort-region) + ("q" . kill-buffer-cmd))) + (mode-keymap-set! 'aws-ec2-ssh km))) + +;;; ============================================================================ +;;; Buffer rendering +;;; ============================================================================ + +(def (aws-refresh-buffer! app instances) + "Populate the *AWS EC2 SSH* buffer with instance data." + (let* ((buf (buffer-by-name "*AWS EC2 SSH*")) + (ed (current-qt-editor app)) + (fr (app-state-frame app))) + (when buf + ;; Convert instances to tabulated-list entries, sorted by name + (let* ((entries (map aws-instance->entry instances)) + (sorted (sort (lambda (a b) + (string<? (vector-ref (cdr a) 0) + (vector-ref (cdr b) 0))) + entries))) + (tabulated-list-set-entries! buf sorted) + ;; Render + (let ((text (tabulated-list-refresh! buf))) + (when text + (sci-send ed SCI_SETREADONLY 0) + (qt-plain-text-edit-set-text! ed text) + (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) + (sci-send ed SCI_SETREADONLY 1) + ;; Position cursor on first data line + (let ((pos (sci-send ed SCI_POSITIONFROMLINE tabulated-list-header-lines 0))) + (qt-plain-text-edit-set-cursor-position! ed pos)) + ;; Brighter caret line for row selection + (sci-send ed SCI_SETCARETLINEBACK (rgb->sci #x2a #x2a #x4a)))))))) + +(def (aws-re-render! app) + "Re-render the current tabulated list state (after filter/sort change)." + (let* ((buf (buffer-by-name "*AWS EC2 SSH*")) + (ed (current-qt-editor app)) + (line (qt-plain-text-edit-cursor-line ed))) + (when buf + (let ((text (tabulated-list-refresh! buf))) + (when text + (sci-send ed SCI_SETREADONLY 0) + (qt-plain-text-edit-set-text! ed text) + (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) + (sci-send ed SCI_SETREADONLY 1) + ;; Restore cursor, clamped to valid range + (let* ((count (tabulated-list-entry-count buf)) + (max-line (+ tabulated-list-header-lines (max 0 (- count 1)))) + (target (min line max-line)) + (pos (sci-send ed SCI_POSITIONFROMLINE (max target tabulated-list-header-lines) 0))) + (qt-plain-text-edit-set-cursor-position! ed pos))))))) + +;;; ============================================================================ +;;; Commands +;;; ============================================================================ + +(def (cmd-aws-ec2-ssh app) + "Browse EC2 instances and SSH to them. +M-x aws-ec2-ssh +Keys: n/p=navigate, RET=ssh, g=refresh, G=force-refresh, /=filter, q=quit" + (let* ((config-count (aws-load-config!)) + (fr (app-state-frame app)) + (ed (current-qt-editor app)) + (echo (app-state-echo app)) + (buf-name "*AWS EC2 SSH*") + (buf (or (buffer-by-name buf-name) + (qt-buffer-create! buf-name ed #f)))) + ;; Switch to buffer + (qt-buffer-attach! ed buf) + (set! (qt-edit-window-buffer (qt-current-window fr)) buf) + ;; Initialize tabulated list state if not already + (unless (tabulated-list-get-state buf) + (tabulated-list-init! buf *aws-columns*)) + ;; Show loading message + (sci-send ed SCI_SETREADONLY 0) + (qt-plain-text-edit-set-text! ed " Fetching EC2 instances...") + (sci-send ed SCI_SETREADONLY 1) + ;; Check cache + (if (aws-cache-valid?) + (begin + (aws-refresh-buffer! app *aws-cache*) + (echo-message! echo + (string-append "Loaded " (number->string (length *aws-cache*)) + " instances from cache"))) + ;; Fetch asynchronously + (begin + (echo-message! echo + (string-append "Fetching instances from " + (number->string (length *aws-ec2-ssh-common-regions*)) + " regions...")) + (aws-fetch-all-regions! + (lambda (instances) + (aws-refresh-buffer! app instances) + (echo-message! echo + (string-append "Loaded " (number->string (length instances)) + " running instances from " + (number->string (length *aws-ec2-ssh-common-regions*)) + " regions")))))))) + +(def (cmd-aws-ec2-ssh-refresh app) + "Refresh instance list (uses cache if valid)." + (let ((echo (app-state-echo app))) + (if (aws-cache-valid?) + (begin + (aws-refresh-buffer! app *aws-cache*) + (echo-message! echo "Refreshed from cache")) + (begin + (echo-message! echo "Fetching instances...") + (aws-fetch-all-regions! + (lambda (instances) + (aws-refresh-buffer! app instances) + (echo-message! echo + (string-append "Loaded " (number->string (length instances)) " instances")))))))) + +(def (cmd-aws-ec2-ssh-force-refresh app) + "Force refresh instance list (bypass cache)." + (aws-cache-clear!) + (let ((echo (app-state-echo app))) + (echo-message! echo "Force fetching instances...") + (aws-fetch-all-regions! + (lambda (instances) + (aws-refresh-buffer! app instances) + (echo-message! echo + (string-append "Loaded " (number->string (length instances)) " instances")))))) + +(def (cmd-aws-ec2-ssh-connect app) + "SSH to the instance at point. +Opens a terminal buffer and types the SSH command, then executes it." + (let* ((buf (current-qt-buffer app)) + (ed (current-qt-editor app)) + (echo (app-state-echo app)) + (line (qt-plain-text-edit-cursor-line ed)) + (entry (tabulated-list-get-entry-at-line buf line))) + (if (not entry) + (echo-message! echo "No instance on this line") + (let* ((vals (cdr entry)) + (name (vector-ref vals 0)) + (state (vector-ref vals 1)) + (ssh-target (vector-ref vals 5))) + (cond + ((string-empty? name) + (echo-message! echo "Instance has no Name tag")) + ((not (string=? state "running")) + (echo-message! echo (string-append "Instance is not running (state: " state ")"))) + ((string=? ssh-target "-") + (echo-message! echo "No SSH target configured for this region")) + (else + (let ((ssh-cmd (if *aws-ec2-ssh-user* + (string-append "ssh " *aws-ec2-ssh-user* "@" ssh-target) + (string-append "ssh " ssh-target)))) + ;; Open a terminal buffer + (execute-command! app 'term) + ;; Insert ssh command at the prompt and execute via terminal-send + (let* ((term-ed (current-qt-editor app)) + (term-buf (current-qt-buffer app)) + (ts (and term-buf (hash-get *terminal-state* term-buf)))) + (when ts + ;; Insert the SSH command text at current position (end of prompt) + (qt-plain-text-edit-move-cursor! term-ed QT_CURSOR_END) + (qt-plain-text-edit-insert-text! term-ed ssh-cmd) + ;; Execute it by dispatching terminal-send + (execute-command! app 'terminal-send) + (echo-message! echo (string-append "SSH: " ssh-target))))))))))) + +(def (cmd-aws-ec2-ssh-filter app) + "Filter instances by string." + (let* ((buf (current-qt-buffer app)) + (query (qt-echo-read-string app "Filter: "))) + (when query + (tabulated-list-filter! buf query) + (aws-re-render! app) + (echo-message! (app-state-echo app) + (if (string-empty? query) + "Filter cleared" + (string-append "Filter: " query " (" + (number->string (tabulated-list-entry-count buf)) + " matches)")))))) +