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