From 094838bd2b9c17eadf7d1df44f62fb02960fb593 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Thu, 26 May 2022 17:07:40 +0200
Subject: [PATCH] Support for running Racket programs as inferior services

---
 syndicate-examples/dummy-port-relay.pr  | 14 ++++++++
 syndicate-examples/dummy-port-relay.rkt | 21 ++++++++++++
 syndicate/distributed/ports.rkt         | 43 +++++++++++++++++++++++++
 3 files changed, 78 insertions(+)
 create mode 100644 syndicate-examples/dummy-port-relay.pr
 create mode 100644 syndicate-examples/dummy-port-relay.rkt
 create mode 100644 syndicate/distributed/ports.rkt

diff --git a/syndicate-examples/dummy-port-relay.pr b/syndicate-examples/dummy-port-relay.pr
new file mode 100644
index 0000000..4be9eec
--- /dev/null
+++ b/syndicate-examples/dummy-port-relay.pr
@@ -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
+  }
+]
diff --git a/syndicate-examples/dummy-port-relay.rkt b/syndicate-examples/dummy-port-relay.rkt
new file mode 100644
index 0000000..47a825b
--- /dev/null
+++ b/syndicate-examples/dummy-port-relay.rkt
@@ -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)))))))))
diff --git a/syndicate/distributed/ports.rkt b/syndicate/distributed/ports.rkt
new file mode 100644
index 0000000..c52afca
--- /dev/null
+++ b/syndicate/distributed/ports.rkt
@@ -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))