From 790945b8280efc272961031467d74e79fddfdd35 Mon Sep 17 00:00:00 2001 From: haskal Date: Wed, 30 Dec 2020 00:34:48 -0500 Subject: [PATCH] implement agent management commands --- Makefile | 8 +++- README.md | 1 + crossfire/agent.rkt | 1 + crossfire/client.rkt | 105 ++++++++++++++++++++++++++++++++++++++----- crossfire/comms.rkt | 4 +- crossfire/server.rkt | 8 +++- 6 files changed, 110 insertions(+), 17 deletions(-) diff --git a/Makefile b/Makefile index 5d67df7..a785838 100644 --- a/Makefile +++ b/Makefile @@ -15,7 +15,7 @@ # You should have received a copy of the GNU Affero General Public License # along with this program. If not, see . -.PHONY: all check clean dev-migrate dev-rollback +.PHONY: all check clean dev-migrate dev-rollback dev-make-agent all: raco pkg install ./crossfire @@ -31,3 +31,9 @@ dev-migrate: dev-rollback: raco north rollback -p crossfire/migrations -f + +dev-make-agent: + cd agent-deployment && $(MAKE) + [ -d lib ] || mkdir lib + cd agent-deployment && for dir in arch_*; do \ + mkdir ../lib/$$dir; cp $$dir/crossfire-agent ../lib/$$dir/; done diff --git a/README.md b/README.md index b7a1e21..423738e 100644 --- a/README.md +++ b/README.md @@ -198,6 +198,7 @@ contributions welcome,,,, - ✅ `crossfire status`: check status of server / task summary - ✅ `crossfire show`: shows task details - ✅ `crossfire setup`: sets up access to a server + - ✅ `crossfire agent`: manage agents - low priority: gui interface (racket/gui & framework time) ## misc diff --git a/crossfire/agent.rkt b/crossfire/agent.rkt index bf099d3..e8a97b8 100644 --- a/crossfire/agent.rkt +++ b/crossfire/agent.rkt @@ -376,6 +376,7 @@ (with-handlers ([exn:break? (lambda (_) (log-agent-info "connection cancelled") (exit))]) + ;; TODO : use net/dns dns lookup if it's a hostname because glibc crashes lol (let loop ([sleep-time 1]) (define maybe-exn (with-handlers ([exn:fail? identity]) diff --git a/crossfire/client.rkt b/crossfire/client.rkt index 9db524e..3bf2a92 100644 --- a/crossfire/client.rkt +++ b/crossfire/client.rkt @@ -17,7 +17,8 @@ ;; along with this program. If not, see . (require file/tar racket/bool racket/contract racket/file racket/format racket/function racket/list - racket/match racket/path racket/string racket/unit racket/vector syntax/parse/define + racket/match racket/path racket/random racket/string racket/unit racket/vector + syntax/parse/define (only-in file/sha1 bytes->hex-string) (for-syntax racket/base racket/list racket/syntax) "codegen.rkt" "comms.rkt" "info.rkt" "manifest.rkt" "not-crypto.rkt" "protocol.rkt") @@ -177,7 +178,7 @@ (format "~a%" (inexact->exact (* 100 (project-info-progress proj)))) (~a (project-info-matches proj))))]) (if (empty? body) - '(("" " - no projects - " "")) + '(("" " - no projects - " "" "")) body)))) @@ -208,6 +209,36 @@ (format "match ~a: ~a" i (format-match m))))) +(define (cmd-agent-list) + (define agents (with-server-connection (get-agents))) + (cons '("id" "name" "arch" "resources" "status") + (if (empty? agents) + '(("" " - no agents - " "" "" "")) + (for/list ([info (in-list agents)]) + (list (~a (node-info-id info)) + (~a (node-info-name info)) + (~a (node-info-arch info)) + (~a (string-join (map ~a (sort (node-info-resources info) stringhex-string (crypto-random-bytes 8)) ".agent")) (define-simple-macro (subcommand (name:id description:str) body ...) #:with name-str (datum->syntax #'name (symbol->string (syntax-e #'name))) @@ -274,6 +303,10 @@ (define name (make-hash (list cmds ...)))) (define flag-mode (make-parameter "stdio")) + (define flag-agent (make-parameter #f)) + (define flag-agent-name (make-parameter #f)) + (define flag-agent-arch (make-parameter #f)) + (define flag-agent-res (make-parameter '())) (define-commands *commands* (subcommand (new "Create a new crossfire project") #:once-each [("-m" "--mode") mode "Project mode (stdio [default] or callback)" @@ -311,13 +344,61 @@ (subcommand (status "Summary of project status on server") #:args () - (interactive-status)) + (print-table (cmd-status))) (subcommand (show "Show information about a project on the server") #:args (id-str) (define id (or (string->number id-str) (error "must provide numeric ID"))) - (interactive-show id)) + (for ([line (in-list (cmd-show id))]) + (displayln line))) + + (subcommand (agent "Manage crossfire agents") + #:once-any + [("-l" "--list") "List agents" (flag-agent (list 'list #f))] + [("-c" "--create") "Create a new agent" (flag-agent (list 'create #f))] + [("-d" "--delete") aid "Delete an agent" (flag-agent (list 'delete aid))] + [("-g" "--get-binary") aid "Redownload the binary for an agent" (flag-agent (list 'get aid))] + #:once-each + [("-a" "--arch") arch "For --create, the agent CPU architecture" (flag-agent-arch arch)] + [("-n" "--name") name "For --create, the agent name" (flag-agent-name name)] + #:multi + [("-r" "--resource") res "For --create, resources to associate with the agent" + (flag-agent-res (cons res (flag-agent-res)))] + #:args () + (define (do-final out-name) + (define perms (file-or-directory-permissions out-name 'bits)) + (file-or-directory-permissions out-name (bitwise-ior perms #o111)) + (report-status "agent executable saved to ~a" out-name)) + + (match (flag-agent) + [(list 'list _) + (print-table (cmd-agent-list))] + [(list 'create _) + (when (or (false? (flag-agent-name)) + (false? (flag-agent-arch))) + (error "you must provide -n and -a for this command")) + (define out-name (make-random-filename)) + (call-with-output-file out-name + (lambda (o) + (define aid (cmd-agent-create (flag-agent-name) (flag-agent-arch) (flag-agent-res) o)) + (report-status "created agent ~a" aid))) + (do-final out-name)] + [(list 'delete aid-str) + (define aid (string->number aid-str)) + (unless aid + (error "invalid agent id provided")) + (cmd-agent-delete aid) + (report-status "deleted agent ~a" aid)] + [(list 'get aid-str) + (define aid (string->number aid-str)) + (unless aid + (error "invalid agent id provided")) + (define out-name (make-random-filename)) + (call-with-output-file out-name + (lambda (o) (cmd-get-deployment aid o))) + (do-final out-name)] + [_ (error "you must provide -l, -c, -d, or -g for this command")])) (subcommand (setup "Set up access to a crossfire server") #:args (config-file) diff --git a/crossfire/comms.rkt b/crossfire/comms.rkt index 088e99b..16d9bed 100644 --- a/crossfire/comms.rkt +++ b/crossfire/comms.rkt @@ -221,7 +221,7 @@ (lambda () (with-handlers ([exn:fail? (lambda (ex) (thread-send from ex #f))]) (match (hash-ref node-registry id #f) - [#f (thread-send from (make-error "no such node" id) #f)] + [#f (thread-send from (make-error (format "no such node ~a" id)) #f)] [(node id name type pubkey seckey host port) (when (and host port) (make-peer-thread (lambda () (tcp-connect host port)) local-msg-channel)) @@ -463,7 +463,7 @@ (match-define (cons to-id (cons rpc-id rpc-data)) data) (send-transaction from to-id rpc-id rpc-data)] ['shutdown (set! run-tm #f) (cleanup) (thread-send from (void) #f)] - [_ (thread-send from (make-error "invalid transaction thread msg" #f))])) + [_ (thread-send from (make-error "invalid transaction thread msg") #f)])) (define (handle-incoming msg) (match msg diff --git a/crossfire/server.rkt b/crossfire/server.rkt index af7f848..b215deb 100644 --- a/crossfire/server.rkt +++ b/crossfire/server.rkt @@ -293,7 +293,11 @@ (enforce-subject 'client) (call-with-transaction (current-db) (lambda () (enforce-object id 'agent) - (query-exec (current-db) q-delete-node id))) + (with-handlers + ([exn:fail:sql? + (lambda (_) + (error "failed to delete agent, perhaps there are some projects referencing it?"))]) + (query-exec (current-db) q-delete-node id)))) (comms-delete-node (current-comms) id) (agent-handler-delete-agent id) (void)) @@ -646,7 +650,7 @@ (define right-arch? (or (member "any" needed-arch) (member arch needed-arch))) (if (and right-arch? (task-has-work? head) - (subset? available-resources needed-resources)) + (subset? needed-resources available-resources)) (create-assignment! head) (select-task! tail))]))