update agent embedding system
This commit is contained in:
parent
7e3d24d294
commit
d88a1c9490
1
.envrc
1
.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
|
||||
|
|
8
Makefile
8
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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
.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
|
||||
|
||||
|
|
|
@ -0,0 +1,4 @@
|
|||
*.o
|
||||
*.zo
|
||||
/crossfire-agent
|
||||
/vendor/
|
|
@ -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
|
|
@ -23,8 +23,10 @@
|
|||
|
||||
#include <monocypher.h>
|
||||
|
||||
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);
|
|
@ -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 ()
|
||||
|
|
|
@ -16,7 +16,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/>.
|
||||
|
||||
(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))
|
||||
|
|
|
@ -1,3 +0,0 @@
|
|||
*.o
|
||||
*.zo
|
||||
/run
|
Loading…
Reference in New Issue