Support for running Racket programs as inferior services
This commit is contained in:
parent
004bcbc5a8
commit
094838bd2b
|
@ -0,0 +1,14 @@
|
||||||
|
; syndicate-server -c dummy-port-relay.pr
|
||||||
|
|
||||||
|
<require-service <daemon dummy-port-relay>>
|
||||||
|
<daemon dummy-port-relay {
|
||||||
|
argv: "racket -y dummy-port-relay.rkt"
|
||||||
|
protocol: application/syndicate
|
||||||
|
}>
|
||||||
|
|
||||||
|
? <service-object <daemon dummy-port-relay> ?cap> [
|
||||||
|
$cap {
|
||||||
|
config: $config
|
||||||
|
log: $log
|
||||||
|
}
|
||||||
|
]
|
|
@ -0,0 +1,21 @@
|
||||||
|
#lang syndicate
|
||||||
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||||
|
;;; SPDX-FileCopyrightText: Copyright © 2022 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||||
|
|
||||||
|
(require syndicate/distributed/ports)
|
||||||
|
|
||||||
|
(message-struct log (timestamp details))
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(standard-actor-system/no-services (ds)
|
||||||
|
(spawn #:name 'main
|
||||||
|
(facet-prevent-inert-check! this-facet)
|
||||||
|
(run-port-relay
|
||||||
|
#:export
|
||||||
|
(ref (during* (lambda (a)
|
||||||
|
(eprintf "assert ~a\n" a)
|
||||||
|
(match (hash-ref a 'log #f)
|
||||||
|
[(embedded l)
|
||||||
|
(send! l (log "-" (hash 'line "hello!")))]
|
||||||
|
[_ (void)])
|
||||||
|
(on-stop (eprintf "retract ~a\n" a)))))))))
|
|
@ -0,0 +1,43 @@
|
||||||
|
#lang syndicate
|
||||||
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
||||||
|
;;; SPDX-FileCopyrightText: Copyright © 2022 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
||||||
|
|
||||||
|
(provide run-port-relay)
|
||||||
|
|
||||||
|
(require syndicate/relay)
|
||||||
|
(require syndicate/driver-support)
|
||||||
|
|
||||||
|
(define-logger syndicate/distributed/ports)
|
||||||
|
|
||||||
|
(define (run-port-relay #:input-port [input-port (current-input-port)]
|
||||||
|
#:output-port [output-port (current-output-port)]
|
||||||
|
#:name [name (gensym 'stdio-relay)]
|
||||||
|
#:export [initial-ref #f]
|
||||||
|
#:import [import-handler #f])
|
||||||
|
(run-relay #:packet-writer
|
||||||
|
(lambda (bs)
|
||||||
|
(log-syndicate/distributed/ports-debug "OUT ~v" bs)
|
||||||
|
(write-bytes bs output-port)
|
||||||
|
(flush-output output-port))
|
||||||
|
#:setup-inputs
|
||||||
|
(lambda (tr)
|
||||||
|
(linked-thread
|
||||||
|
#:name (list name 'input)
|
||||||
|
(lambda (facet)
|
||||||
|
(define buffer (make-bytes 2048))
|
||||||
|
(let loop ()
|
||||||
|
(match (read-bytes-avail! buffer input-port)
|
||||||
|
[(? number? n)
|
||||||
|
(define bs (subbytes buffer 0 n))
|
||||||
|
(log-syndicate/distributed/ports-debug "IN ~v" bs)
|
||||||
|
(turn! facet (lambda () (accept-bytes tr bs)))
|
||||||
|
(loop)]
|
||||||
|
[(? eof-object?)
|
||||||
|
(turn! facet (stop-current-facet))])))))
|
||||||
|
#:then
|
||||||
|
(and import-handler
|
||||||
|
(ref (entity #:name (list name 'import-handler)
|
||||||
|
#:assert (lambda (a _h) (import-handler a)))))
|
||||||
|
#:name name
|
||||||
|
#:initial-oid (and import-handler 0)
|
||||||
|
#:initial-ref initial-ref))
|
Loading…
Reference in New Issue