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