58 lines
2.3 KiB
Racket
58 lines
2.3 KiB
Racket
#lang syndicate
|
|
;; Explore use of sandboxes etc for being an "operating system"
|
|
|
|
(require racket/match)
|
|
(require racket/sandbox)
|
|
|
|
(define (program-boot-actions modspec)
|
|
(parameterize ((sandbox-input (current-input-port))
|
|
(sandbox-output (current-output-port)))
|
|
(define e (make-evaluator 'racket/base))
|
|
(define ns (call-in-sandbox-context e current-namespace))
|
|
(for [(syndicate-modspec (in-list (list 'syndicate/actor
|
|
'syndicate/canonicalize
|
|
'syndicate/core
|
|
'syndicate/treap
|
|
'syndicate/trie
|
|
'syndicate/tset)))]
|
|
(namespace-attach-module (current-namespace) syndicate-modspec ns))
|
|
(e `(require (submod ,modspec syndicate-main)))
|
|
(e `(activate!))))
|
|
|
|
(struct running-app (id) #:prefab) ;; assertion
|
|
(struct kill-app (id) #:prefab) ;; message
|
|
|
|
(struct named-account (name balance) #:prefab) ;; assertion
|
|
|
|
(define (run-bank-account name)
|
|
(struct account (balance) #:prefab)
|
|
(dataspace (define id (symbol->string (gensym 'app)))
|
|
(printf "Starting app ~a\n" id)
|
|
(schedule-action! (program-boot-actions 'syndicate/examples/actor/bank-account))
|
|
(spawn
|
|
(assert (outbound (running-app id)))
|
|
(on (message (inbound (kill-app id)))
|
|
(printf "Received signal for app ~a\n" id)
|
|
(quit-dataspace!))
|
|
(during (account $balance)
|
|
(assert (outbound (named-account name balance)))))))
|
|
|
|
(run-bank-account 'a)
|
|
(run-bank-account 'b)
|
|
(run-bank-account 'c)
|
|
|
|
(spawn (on (asserted (named-account $name $balance))
|
|
(printf "Named account balance ~a = ~a\n" name balance)))
|
|
|
|
(spawn (define/query-set running-apps (running-app $id) id)
|
|
(begin/dataflow (printf "Running apps: ~v\n" (running-apps))))
|
|
|
|
(let ()
|
|
(local-require racket/port)
|
|
(define e (read-bytes-line-evt (current-input-port) 'any))
|
|
(spawn (stop-when (message (inbound (external-event e (list (? eof-object? _))))))
|
|
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
|
(define app-id (bytes->string/utf-8 bs))
|
|
(printf "Killing ~a\n" app-id)
|
|
(send! (kill-app app-id)))))
|