haskal
/
crossfire
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

implement agent management commands

This commit is contained in:
xenia 2020-12-30 00:34:48 -05:00
parent fc83741b02
commit 790945b828
6 changed files with 110 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile
View File

@ -15,7 +15,7 @@
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
.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

1
README.md
View File

@ -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

1
crossfire/agent.rkt
View File

@ -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])

105
crossfire/client.rkt
View File

@ -17,7 +17,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(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) string<?)) ", "))
(if (node-info-online? info) "ONLINE" "OFFLINE"))))))
(define (cmd-agent-create name arch resources out-port)
(with-server-connection
(define id (new-agent name arch resources))
;; TODO : streaming
(write-bytes (get-agent-deployment id) out-port)
id))
(define (cmd-agent-delete id)
(with-server-connection
(delete-agent id)))
(define (cmd-get-deployment id out-port)
(with-server-connection
;; TODO : streaming
(write-bytes (get-agent-deployment id) out-port)
(void)))
(define (cmd-setup config)
(make-parent-directory* *client-key-file*)
(with-output-to-file *client-key-file* (lambda () (write config)) #:exists 'replace))
@ -242,18 +273,16 @@
(report-status "error: ~a" warning))
(report-fatal-error "check was not successful due to above messages")]))
(define (interactive-status)
(define status-tbl (cmd-status))
(define max-widths (for/list ([_ (in-list (first status-tbl))] [i (in-naturals)])
(apply max (map (lambda (x) (string-length (list-ref x i))) status-tbl))))
(for ([row (in-list status-tbl)])
(define (print-table table)
(define max-widths (for/list ([_ (in-list (first table))] [i (in-naturals)])
(apply max (map (lambda (x) (string-length (list-ref x i))) table))))
(for ([row (in-list table)])
(for ([item (in-list row)] [width (in-list max-widths)])
(write-string (~a item #:width (+ 2 width))))
(write-string "\n")))
(define (interactive-show id)
(for ([line (in-list (cmd-show id))])
(displayln line)))
(define (make-random-filename)
(string-append (bytes->hex-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)

4
crossfire/comms.rkt
View File

@ -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

8
crossfire/server.rkt
View File

@ -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))]))