ed ... packet ed ... ped ... pedipalps ... palps. its a bug thing

palps.rkt

@@ -0,0 +1,74 @@
+#! /usr/bin/env /usr/local/bin/racket
+#lang racket
+
+;; get callsign, first thing passed by BPQ
+(define call (read-line (current-input-port) 'any))
+
+;; drop SSID
+(set! call (first (string-split call "-")))
+
+;; downcase callsign
+(set! call (string-downcase call))
+
+;; if the sysadmin has created a directory for that callsign, then
+;; they are an authorized user.
+(when (not (directory-exists? call))
+  (displayln "sorry, but you are not an authorized user of the PALPS system")
+  (flush-output)
+  (exit))
+
+;; change to the authroized users directory
+(current-directory call)
+
+(printf "welcome ~a. now starting (r)ed, the standard text editor~n" call)
+(flush-output)
+
+;; unfortunately, we cannot just exec red and let it take over the
+;; I/O. ed, being the standard text editor, only works with standard
+;; line endings, \n. telnet and BPQ, however, use \r\n. \r\n upsets
+;; ed, the standard text editor.  so we need to wrap the input and
+;; output ports ourselves in order to provide this translation.
+
+(match-define
+  (list stdout stdin pid stderr proc)
+  (process* "/usr/bin/red"
+            "-p*"
+            #:set-pwd? #t))
+
+(define buffer (make-bytes 128))
+
+(define (loop)
+  (let ([evt-result
+         (sync
+          (choice-evt (read-bytes-avail!-evt buffer stdout)
+                      (read-line-evt (current-input-port) 'any)))])
+
+    (cond
+      ;; read-line-evt results in a string. we have something to write
+      ;; on stdin.
+      [(string? evt-result)
+       (displayln evt-result stdin)
+       (flush-output stdin)
+       (loop)]
+
+      ;; read-bytes-avail!-evt results in an integer. we have
+      ;; something to read from stdout.
+      [(integer? evt-result)
+       (display (bytes->string/utf-8 (subbytes buffer 0 evt-result)))
+       (flush-output)
+       (loop)]
+
+      ;; either event may EOF, which means that ed has died.
+      [(eof-object? evt-result)
+       ;; clean up
+       (close-output-port stdin)
+       (close-input-port stdout)
+       (close-input-port stderr)
+       (proc 'kill)])))
+
+(loop)
+
+(displayln "goodbye")
+(flush-output)
+
+(exit)