diff --git a/.envrc b/.envrc index 07423d4..46e2e25 100644 --- a/.envrc +++ b/.envrc @@ -1,3 +1,2 @@ -export LD_LIBRARY_PATH="$PWD/lib:$LD_LIBRARY_PATH" export DATABASE_URL="sqlite:lib/crossfire.sqlite" [ ! -d lib ] && mkdir lib diff --git a/Makefile b/Makefile index c252cab..6354730 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 monocypher dev-migrate dev-rollback +.PHONY: all check clean dev-migrate dev-rollback all: raco setup ./crossfire/ @@ -26,12 +26,6 @@ check: clean: $(RM) -r crossfire/doc crossfire/compiled crossfire/scribblings/compiled lib/ -monocypher: lib/monocypher.so - -lib/monocypher.so: /usr/include/monocypher/monocypher.c /usr/include/monocypher/monocypher-ed25519.c - [ -d lib ] || mkdir lib - $(CC) -o $@ -O3 -pipe -shared $^ - dev-migrate: raco north migrate -p crossfire/migrations -f diff --git a/agent-deployment/.gitignore b/agent-deployment/.gitignore new file mode 100644 index 0000000..ca7c7de --- /dev/null +++ b/agent-deployment/.gitignore @@ -0,0 +1,4 @@ +*.o +*.zo +/crossfire-agent +/vendor/ diff --git a/static/Makefile b/agent-deployment/Makefile similarity index 64% rename from static/Makefile rename to agent-deployment/Makefile index 11cab14..ff7da77 100644 --- a/static/Makefile +++ b/agent-deployment/Makefile @@ -17,10 +17,10 @@ .PHONY: all clean -APP_NAME=run +APP_NAME=crossfire-agent RKT_NAME=$(APP_NAME).rkt -MONOCYPHER_INC=/usr/include/monocypher +MONOCYPHER_VERSION=3.1.1 #################################################################################################### @@ -28,17 +28,26 @@ LIBS=-ldl -lm # for musl #LIBS=-lffi -lucontext +VENDOR_DIR=vendor +MONOCYPHER_DIR=$(VENDOR_DIR)/monocypher-$(MONOCYPHER_VERSION) +MONOCYPHER_URL=https://monocypher.org/download/monocypher-$(MONOCYPHER_VERSION).tar.gz + all: $(APP_NAME) # main build -$(APP_NAME): main_bc.c app.o monocypher.o monocypher-ed25519.o - $(CC) -o $@ -pipe -fPIC -O3 -DAPP_NAME='"$(APP_NAME)"' -I$(MONOCYPHER_INC) -static $^ \ - -lracket3m -lrktio $(LIBS) +$(APP_NAME): main_bc.c app.o $(MONOCYPHER_DIR)/lib/libmonocypher.a + $(CC) -o $@ -pipe -fPIC -O3 -DAPP_NAME='"$(APP_NAME)"' -I$(MONOCYPHER_DIR)/src -static $^ \ + -L$(MONOCYPHER_DIR)/lib \ + -lracket3m -lrktio -lmonocypher $(LIBS) -monocypher.o: $(MONOCYPHER_INC)/monocypher.c - $(CC) -o $@ -pipe -fPIC -O3 -I$(MONOCYPHER_INC) -c $^ -monocypher-ed25519.o: $(MONOCYPHER_INC)/monocypher-ed25519.c - $(CC) -o $@ -pipe -fPIC -O3 -I$(MONOCYPHER_INC) -c $^ +$(MONOCYPHER_DIR)/lib/libmonocypher.a: $(MONOCYPHER_DIR)/.extracted + cd $(MONOCYPHER_DIR) && $(MAKE) USE_ED22519=true static-library + +$(MONOCYPHER_DIR)/.extracted: $(MONOCYPHER_DIR).tar.gz + tar xf $< -C $(VENDOR_DIR) && touch $@ + +$(MONOCYPHER_DIR).tar.gz: + wget -O $@ $(MONOCYPHER_URL) || curl -o $@ $(MONOCYPHER_URL) # this is faster than --c-mods by a lot # it's less portable but like, we're containerized already so it'll work diff --git a/static/run.rkt b/agent-deployment/crossfire-agent.rkt similarity index 100% rename from static/run.rkt rename to agent-deployment/crossfire-agent.rkt diff --git a/static/main_bc.c b/agent-deployment/main_bc.c similarity index 89% rename from static/main_bc.c rename to agent-deployment/main_bc.c index 74fce82..fbc4ef0 100644 --- a/static/main_bc.c +++ b/agent-deployment/main_bc.c @@ -23,8 +23,10 @@ #include -extern const char _binary_app_zo_start; -extern const char _binary_app_zo_end; +#define rkt_app_start _binary_app_zo_start +#define rkt_app_end _binary_app_zo_end +extern const char rkt_app_start; +extern const char rkt_app_end; // ffi defs typedef struct { @@ -69,7 +71,7 @@ static int run_bc(Scheme_Env* e, int argc, char* argv[]) { volatile mz_jmp_buf* save; mz_jmp_buf fresh; int rv = 0; - size_t load_size = ((uintptr_t) &_binary_app_zo_end) - ((uintptr_t) &_binary_app_zo_start); + size_t load_size = ((uintptr_t) &rkt_app_end) - ((uintptr_t) &rkt_app_start); Scheme_Object* l = NULL; Scheme_Object* a[2] = { NULL, NULL }; @@ -82,8 +84,8 @@ static int run_bc(Scheme_Env* e, int argc, char* argv[]) { bc_setup_ffi_table(e); - scheme_register_embedded_load(load_size, &_binary_app_zo_start); - scheme_embedded_load(load_size, &_binary_app_zo_start, 1); + scheme_register_embedded_load(load_size, &rkt_app_start); + scheme_embedded_load(load_size, &rkt_app_start, 1); l = scheme_make_null(); l = scheme_make_pair(scheme_intern_symbol(APP_NAME), l); diff --git a/crossfire/not-crypto.rkt b/crossfire/not-crypto.rkt index b4812f5..588f78c 100644 --- a/crossfire/not-crypto.rkt +++ b/crossfire/not-crypto.rkt @@ -33,7 +33,7 @@ (define ((bytes-len/c len) bs) (and bytes? bs) (= len (bytes-length bs))) -(define monocypher (ffi-lib/runtime "monocypher")) +(define monocypher (ffi-lib/runtime "libmonocypher")) (define-syntax (define/ffi stx) (syntax-case stx () diff --git a/crossfire/protocol.rkt b/crossfire/protocol.rkt index 325a609..5b3d3bb 100644 --- a/crossfire/protocol.rkt +++ b/crossfire/protocol.rkt @@ -16,7 +16,7 @@ ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see . -(require db/base db/sqlite3 racket/bool racket/match racket/runtime-path racket/path +(require db/base db/sqlite3 racket/bool racket/match racket/runtime-path racket/path racket/set north/base north/adapter/base north/adapter/sqlite "comms.rkt" "not-crypto.rkt") @@ -59,11 +59,15 @@ (define name (virtual-statement what))) (define-stmt q-new-node "insert into node (name, type, secret) values (?, ?, ?)") -(define-stmt q-assign-node-res "insert into node_resource (nodeid, resource) values (?, ?)") +(define-stmt q-add-node-res "insert or ignore into node_resource (nodeid, resource) values (?, ?)") +(define-stmt q-del-node-res "delete from node_resource where nodeid=? and resource=?") (define-stmt q-get-nodes "select id, name from node where type=?") -(define-stmt q-get-resources +(define-stmt q-get-all-resources "select nodeid, resource from node_resource inner join node on node.id = node_resource.nodeid where node.type = ?") +(define-stmt q-get-node-resources "select resource from node_resource where nodeid=?") +(define-stmt q-edit-node "update node set name=? where id=?") +(define-stmt q-get-node-type "select type from node where id=?") ;; rpc calls @@ -74,7 +78,7 @@ (define (get-nodes type) (define type-str (symbol->string type)) (define resources (rows->dict #:key "nodeid" #:value "resource" #:value-mode '(list) - (query (current-db) q-get-resources type-str))) + (query (current-db) q-get-all-resources type-str))) (for/list ([(id name) (in-query (current-db) q-get-nodes type-str)]) (define online? (and (current-comms) (comms-channel-available? (current-comms) id))) (node-info id name (hash-ref resources id) online?))) @@ -86,35 +90,54 @@ (define info (simple-result-info (query (current-db) q-new-node name "agent" secret))) (define id (cdr (assoc 'insert-id info))) (for ([res (in-list resources)]) - (query-exec (current-db) q-assign-node-res id res)) + (query-exec (current-db) q-add-node-res id res)) (values id public)))) -(define (enforce type) +(define (enforce-subject type) (unless (symbol=? type (node-type (current-from-node))) (error "unauthorized"))) +(define (enforce-object id type) + (match (query-maybe-value (current-db) q-get-node-type id) + [#f (error "node doesn't exist" id)] + [(== (symbol->string type)) (void)] + [x (error "wrong node type" x)])) + ;; client rpcs (define-rpc server (get-agents) - (enforce 'client) + (enforce-subject 'client) (get-nodes 'agent)) (define-rpc server (new-agent name resources) - (enforce 'client) + (enforce-subject 'client) (define-values [id public] (make-agent name resources)) (define comms-node (node id name 'agent public #f #f #f)) (comms-set-node-info (current-comms) comms-node) id) +(define-rpc server (edit-agent id name resources) + (enforce-subject 'client) + (call-with-transaction (current-db) (lambda () + (enforce-object id 'agent) + (define existing-resource (list->set (query-list (current-db) q-get-node-resources id))) + (define new-resource (list->set resources)) + (query-exec (current-db) q-edit-node name id) + (for ([res (in-set (set-subtract new-resource existing-resource))]) + (query-exec (current-db) q-add-node-res id res)) + (for ([res (in-set (set-subtract existing-resource new-resource))]) + (query-exec (current-db) q-del-node-res id res))))) + (define-rpc server (get-agent-deployment id) - (enforce 'client) + (enforce-subject 'client) + (enforce-object id 'agent) ;; bake secret key into binary and ship it i guess (error "TODO")) ;; agent rpcs (define-rpc server (agent-report something) - (enforce 'agent) + (enforce-subject 'agent) (error "TODO")) @@ -124,5 +147,7 @@ (current-db (open-server-db 'create)) (migrate-server-db) ;;(make-agent "agent0" '("gpu" "hifive")) + (parameterize ([current-from-node (node 100 "meow" 'client #f #f #f #f)]) + ((rpc-impl server edit-agent) 1 "meow0" '("cpu" "hifive"))) (get-nodes 'agent) (get-nodes 'meow)) diff --git a/static/.gitignore b/static/.gitignore deleted file mode 100644 index ea21896..0000000 --- a/static/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -*.o -*.zo -/run