implement embedding config params in agent binary
This commit is contained in:
parent
1d332880ff
commit
08703525d8
|
@ -5,5 +5,6 @@
|
||||||
*.dep
|
*.dep
|
||||||
*.so
|
*.so
|
||||||
*.sqlite
|
*.sqlite
|
||||||
|
/lib
|
||||||
/crossfire/compiled/
|
/crossfire/compiled/
|
||||||
/crossfire/doc/
|
/crossfire/doc/
|
||||||
|
|
|
@ -43,6 +43,7 @@ all: $(ARCH_DIR)/$(APP_NAME)
|
||||||
$(ARCH_DIR)/$(APP_NAME): main_bc.c app.o $(MONOCYPHER_DIR)/lib/libmonocypher.a
|
$(ARCH_DIR)/$(APP_NAME): main_bc.c app.o $(MONOCYPHER_DIR)/lib/libmonocypher.a
|
||||||
[ -d $(ARCH_DIR) ] || mkdir -p $(ARCH_DIR)
|
[ -d $(ARCH_DIR) ] || mkdir -p $(ARCH_DIR)
|
||||||
$(CC) -o $@ -pipe -fPIC -O3 -DAPP_NAME='"$(APP_NAME)"' -I$(MONOCYPHER_DIR)/src -static $^ \
|
$(CC) -o $@ -pipe -fPIC -O3 -DAPP_NAME='"$(APP_NAME)"' -I$(MONOCYPHER_DIR)/src -static $^ \
|
||||||
|
-DAPP_ARCH='"$(TARGET_ARCH)"' \
|
||||||
-L$(MONOCYPHER_DIR)/lib \
|
-L$(MONOCYPHER_DIR)/lib \
|
||||||
-lracket3m -lrktio -lmonocypher $(LIBS)
|
-lracket3m -lrktio -lmonocypher $(LIBS)
|
||||||
|
|
||||||
|
|
|
@ -16,15 +16,32 @@
|
||||||
;; You should have received a copy of the GNU Affero General Public License
|
;; 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/>.
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(require "../crossfire/not-crypto.rkt")
|
(require racket/fasl racket/file racket/match racket/port racket/string
|
||||||
|
"../crossfire/static-support.rkt"
|
||||||
|
"../crossfire/not-crypto.rkt" "../crossfire/comms.rkt")
|
||||||
|
|
||||||
(crypto-sign-public-key #"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
|
; (crypto-sign-public-key #"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
|
||||||
|
;
|
||||||
|
; (define key (crypto-lock-make-key))
|
||||||
|
; (define nonce (crypto-lock-make-nonce))
|
||||||
|
; (define pt #"hello world")
|
||||||
|
;
|
||||||
|
; (define-values [ct mac] (crypto-lock key nonce pt))
|
||||||
|
;
|
||||||
|
; (displayln (crypto-unlock key nonce mac ct))
|
||||||
|
; (displayln (crypto-unlock key nonce mac (bytes-append ct #"abcd")))
|
||||||
|
|
||||||
(define key (crypto-lock-make-key))
|
(define (get-config.linux-gnu)
|
||||||
(define nonce (crypto-lock-make-nonce))
|
(call-with-input-file "/proc/self/exe"
|
||||||
(define pt #"hello world")
|
(lambda (in)
|
||||||
|
(file-position in eof)
|
||||||
|
(define len (file-position in))
|
||||||
|
(file-position in (- len 4))
|
||||||
|
(define offset (integer-bytes->integer (port->bytes in) #f #t))
|
||||||
|
(file-position in (- len offset))
|
||||||
|
(fasl->s-exp in))))
|
||||||
|
|
||||||
(define-values [ct mac] (crypto-lock key nonce pt))
|
(match (string-split (static-ffi-arch) "-")
|
||||||
|
[(list _ ... "linux" "gnu") (get-config.linux-gnu)]
|
||||||
|
[arch (error "XXX: don't know how to get config on arch" arch)])
|
||||||
|
|
||||||
(displayln (crypto-unlock key nonce mac ct))
|
|
||||||
(displayln (crypto-unlock key nonce mac (bytes-append ct #"abcd")))
|
|
||||||
|
|
|
@ -38,7 +38,13 @@ typedef struct {
|
||||||
#define FFI_ENT(name) {STR(name), (uintptr_t) name}
|
#define FFI_ENT(name) {STR(name), (uintptr_t) name}
|
||||||
|
|
||||||
static const ffi_ent ffi_table[] = {
|
static const ffi_ent ffi_table[] = {
|
||||||
FFI_ENT(crypto_sign_public_key)
|
FFI_ENT(crypto_sign_public_key),
|
||||||
|
FFI_ENT(crypto_sign),
|
||||||
|
FFI_ENT(crypto_key_exchange_public_key),
|
||||||
|
FFI_ENT(crypto_key_exchange),
|
||||||
|
FFI_ENT(crypto_lock),
|
||||||
|
FFI_ENT(crypto_unlock),
|
||||||
|
FFI_ENT(crypto_wipe)
|
||||||
};
|
};
|
||||||
static const size_t ffi_table_size = sizeof(ffi_table)/sizeof(ffi_ent);
|
static const size_t ffi_table_size = sizeof(ffi_table)/sizeof(ffi_ent);
|
||||||
|
|
||||||
|
@ -47,12 +53,14 @@ static void bc_setup_ffi_table(Scheme_Env* parent) {
|
||||||
Scheme_Env* mod = NULL;
|
Scheme_Env* mod = NULL;
|
||||||
Scheme_Object* table = NULL;
|
Scheme_Object* table = NULL;
|
||||||
Scheme_Object* table_size = NULL;
|
Scheme_Object* table_size = NULL;
|
||||||
|
Scheme_Object* arch = NULL;
|
||||||
|
|
||||||
MZ_GC_DECL_REG(4);
|
MZ_GC_DECL_REG(5);
|
||||||
MZ_GC_VAR_IN_REG(0, parent);
|
MZ_GC_VAR_IN_REG(0, parent);
|
||||||
MZ_GC_VAR_IN_REG(1, mod);
|
MZ_GC_VAR_IN_REG(1, mod);
|
||||||
MZ_GC_VAR_IN_REG(2, table);
|
MZ_GC_VAR_IN_REG(2, table);
|
||||||
MZ_GC_VAR_IN_REG(3, table_size);
|
MZ_GC_VAR_IN_REG(3, table_size);
|
||||||
|
MZ_GC_VAR_IN_REG(4, arch);
|
||||||
MZ_GC_REG();
|
MZ_GC_REG();
|
||||||
|
|
||||||
mod = scheme_primitive_module(scheme_intern_symbol("#%static-ffi"), parent);
|
mod = scheme_primitive_module(scheme_intern_symbol("#%static-ffi"), parent);
|
||||||
|
@ -60,6 +68,8 @@ static void bc_setup_ffi_table(Scheme_Env* parent) {
|
||||||
scheme_add_global("table", table, mod);
|
scheme_add_global("table", table, mod);
|
||||||
table_size = scheme_make_integer(ffi_table_size);
|
table_size = scheme_make_integer(ffi_table_size);
|
||||||
scheme_add_global("table-size", table_size, mod);
|
scheme_add_global("table-size", table_size, mod);
|
||||||
|
arch = scheme_make_utf8_string(APP_ARCH);
|
||||||
|
scheme_add_global("arch", arch, mod);
|
||||||
scheme_finish_primitive_module(mod);
|
scheme_finish_primitive_module(mod);
|
||||||
|
|
||||||
MZ_GC_UNREG();
|
MZ_GC_UNREG();
|
||||||
|
|
|
@ -40,7 +40,7 @@
|
||||||
|
|
||||||
;; node info (not all fields will always be present)
|
;; node info (not all fields will always be present)
|
||||||
;; type: 'server 'agent 'client
|
;; type: 'server 'agent 'client
|
||||||
(struct node [id name type pubkey seckey host port] #:transparent)
|
(struct node [id name type pubkey seckey host port] #:prefab)
|
||||||
(provide (struct-out node))
|
(provide (struct-out node))
|
||||||
|
|
||||||
;; creates an exn:fail to be passed by thread mailbox
|
;; creates an exn:fail to be passed by thread mailbox
|
||||||
|
|
|
@ -16,7 +16,9 @@
|
||||||
;; You should have received a copy of the GNU Affero General Public License
|
;; 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/>.
|
;; 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 racket/set
|
(require db/base db/sqlite3
|
||||||
|
racket/bool racket/fasl racket/file racket/match racket/runtime-path racket/path
|
||||||
|
racket/set racket/string
|
||||||
north/base north/adapter/base north/adapter/sqlite
|
north/base north/adapter/base north/adapter/sqlite
|
||||||
"comms.rkt" "not-crypto.rkt")
|
"comms.rkt" "not-crypto.rkt")
|
||||||
|
|
||||||
|
@ -26,6 +28,11 @@
|
||||||
|
|
||||||
(define SERVER-DATA-DIR (if PRODUCTION? "/var/lib/crossfire/" "lib/"))
|
(define SERVER-DATA-DIR (if PRODUCTION? "/var/lib/crossfire/" "lib/"))
|
||||||
(define SERVER-DB-PATH (build-path SERVER-DATA-DIR "crossfire.sqlite"))
|
(define SERVER-DB-PATH (build-path SERVER-DATA-DIR "crossfire.sqlite"))
|
||||||
|
(define AGENT-ARCH-PREFIX "arch_")
|
||||||
|
(define AGENT-BINARY "crossfire-agent")
|
||||||
|
|
||||||
|
;; comms node for server (without secret key)
|
||||||
|
(define current-server-public-node (make-parameter #f))
|
||||||
|
|
||||||
;; north migrations
|
;; north migrations
|
||||||
(define-runtime-path migrations-dir "migrations/")
|
(define-runtime-path migrations-dir "migrations/")
|
||||||
|
@ -68,6 +75,7 @@
|
||||||
(define-stmt q-get-node-resources "select resource from node_resource where nodeid=?")
|
(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-edit-node "update node set name=? where id=?")
|
||||||
(define-stmt q-get-node-type "select type from node where id=?")
|
(define-stmt q-get-node-type "select type from node where id=?")
|
||||||
|
(define-stmt q-get-node-info "select name, arch, type, secret from node where id=?")
|
||||||
|
|
||||||
;; rpc calls
|
;; rpc calls
|
||||||
|
|
||||||
|
@ -94,6 +102,23 @@
|
||||||
(query-exec (current-db) q-add-node-res id res))
|
(query-exec (current-db) q-add-node-res id res))
|
||||||
(values id public))))
|
(values id public))))
|
||||||
|
|
||||||
|
(define (configure-agent-binary agent-node agent-arch server-node)
|
||||||
|
;; TODO : assumes unix
|
||||||
|
(define binary
|
||||||
|
(file->bytes
|
||||||
|
(build-path SERVER-DATA-DIR (string-append AGENT-ARCH-PREFIX agent-arch) AGENT-BINARY)))
|
||||||
|
|
||||||
|
(define (configure.linux-gnu)
|
||||||
|
(define trailing-data (s-exp->fasl (list agent-node server-node)))
|
||||||
|
;; write 32 bit unsigned big endian trailer size (including size)
|
||||||
|
(define trailing-size
|
||||||
|
(integer->integer-bytes (+ 4 (bytes-length trailing-data)) 4 #f #t))
|
||||||
|
(bytes-append binary trailing-data trailing-size))
|
||||||
|
|
||||||
|
(match (string-split agent-arch "-")
|
||||||
|
[(list _ ... "linux" "gnu") (configure.linux-gnu)]
|
||||||
|
[_ (error "XXX: don't know how to configure arch" agent-arch)]))
|
||||||
|
|
||||||
(define (enforce-subject type)
|
(define (enforce-subject type)
|
||||||
(unless (symbol=? type (node-type (current-from-node)))
|
(unless (symbol=? type (node-type (current-from-node)))
|
||||||
(error "unauthorized")))
|
(error "unauthorized")))
|
||||||
|
@ -131,9 +156,11 @@
|
||||||
|
|
||||||
(define-rpc server (get-agent-deployment id)
|
(define-rpc server (get-agent-deployment id)
|
||||||
(enforce-subject 'client)
|
(enforce-subject 'client)
|
||||||
(enforce-object id 'agent)
|
(match (query-maybe-row (current-db) q-get-node-info id)
|
||||||
;; bake secret key into binary and ship it i guess
|
[(vector name arch "agent" secret)
|
||||||
(error "TODO"))
|
(configure-agent-binary (node id name 'agent (crypto-sign-public-key secret) secret #f #f)
|
||||||
|
arch (current-server-public-node))]
|
||||||
|
[_ (error "invalid id or wrong node type")]))
|
||||||
|
|
||||||
;; agent rpcs
|
;; agent rpcs
|
||||||
|
|
||||||
|
@ -147,8 +174,14 @@
|
||||||
(require racket/cmdline)
|
(require racket/cmdline)
|
||||||
(current-db (open-server-db 'create))
|
(current-db (open-server-db 'create))
|
||||||
(migrate-server-db)
|
(migrate-server-db)
|
||||||
(make-node "agent0" "x86_64" 'agent '("gpu" "hifive"))
|
(define data (configure-agent-binary (node 10 "meow0" 'agent #f #f #f #f)
|
||||||
(parameterize ([current-from-node (node 100 "meow" 'client #f #f #f #f)])
|
"aarch64-unknown-linux-gnu"
|
||||||
((rpc-impl server edit-agent) 1 "meow0" '("cpu" "hifive")))
|
(node 0 "server" 'server #f #f "meow.systems" 1337)))
|
||||||
(get-nodes 'agent)
|
(with-output-to-file "/tmp/crossfire-agent.configured"
|
||||||
(get-nodes 'meow))
|
(lambda () (write-bytes data)))
|
||||||
|
; (make-node "agent0" "x86_64" 'agent '("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)
|
||||||
|
)
|
||||||
|
|
|
@ -17,7 +17,7 @@
|
||||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(require ffi/unsafe racket/bool)
|
(require ffi/unsafe racket/bool)
|
||||||
(provide get-ffi-obj/static static-ffi-available?
|
(provide get-ffi-obj/static static-ffi-available? static-ffi-arch
|
||||||
ffi-lib/runtime get-ffi-obj/runtime)
|
ffi-lib/runtime get-ffi-obj/runtime)
|
||||||
|
|
||||||
;; this module provides utility functions for interacting with static ffi tables provided by an
|
;; this module provides utility functions for interacting with static ffi tables provided by an
|
||||||
|
@ -58,6 +58,10 @@
|
||||||
(get-ffi-obj/static name type)
|
(get-ffi-obj/static name type)
|
||||||
(get-ffi-obj name lib type)))
|
(get-ffi-obj name lib type)))
|
||||||
|
|
||||||
|
;; retrieves the CROSSFIRE_ARCH the embedding runtime was compiled with
|
||||||
|
(define (static-ffi-arch)
|
||||||
|
(dynamic-require ''#%static-ffi 'arch))
|
||||||
|
|
||||||
;; retrieve an object of a given name and type from the static ffi table, if it exists
|
;; retrieve an object of a given name and type from the static ffi table, if it exists
|
||||||
;; otherwise raise error
|
;; otherwise raise error
|
||||||
(define (get-ffi-obj/static name type)
|
(define (get-ffi-obj/static name type)
|
||||||
|
|
Loading…
Reference in New Issue