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