declare where dynamic application specific data is to be stored

palps.rkt

@@ -1,75 +1,73 @@
 #! /usr/bin/env /usr/local/bin/racket
 #lang racket
 
-;; get callsign, first thing passed by BPQ
+;; default directory used for storing dynamic application data
-(define call (read-line (current-input-port) 'any))
+(define data-dir
+  (build-path (find-system-path 'home-dir)
+              (build-path ".local" "share" "palps")))
 
-;; drop SSID
+(define (call-valid? call)
-(set! call (first (string-split call "-")))
+  (and
+   (<= (string-length call) 9)
+   (andmap
+    (or/c char-numeric? char-alphabetic? (curry char=? #\-))
+    (string->list call))))
 
-;; downcase callsign
+(define (our-make-temporary-file [copy-from #f])
-(set! call (string-downcase call))
+  ;; when deployed as a systemd socket, this program is expected to be
-
+  ;; ran with PrivateTmp. however, in case this is not true, we still
-;; if the sysadmin has created a directory for that callsign, then
+  ;; make our own directory. "red", the restricted version of "ed",
-;; they are an authorized user.
+  ;; has no facility for getting outside of the directory we start it
-(when (not (directory-exists? call))
+  ;; in.
-  (displayln "sorry, but you are not an authorized user of the PALPS system")
+  (make-temporary-file "red.~a"
-  (displayln "visit https://gitea.farpn.net/w6vvn/palps for an explanation")
+                       #:copy-from copy-from
-  (flush-output)
+                       #:base-dir (make-temporary-directory)))
-  (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.
+(define (ed [path (our-make-temporary-file)])
+  (match-define
+    (list stdout stdin pid stderr proc)
+    (parameterize ([current-directory (path-only path)])
+      (process* "/usr/bin/red"
+                "-p*"
+                (path->string (file-name-from-path path))
+                #:set-pwd? #t)))
 
-(match-define
+  (define buffer (make-bytes 128))
-  (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)))])
 
-(define (loop)
+      (cond
-  (let ([evt-result
+        ;; read-line-evt results in a string. we have something to write
-         (sync
+        ;; on stdin.
-          (choice-evt (read-bytes-avail!-evt buffer stdout)
+        [(string? evt-result)
-                      (read-line-evt (current-input-port) 'any)))])
+         (displayln evt-result stdin)
+         (flush-output stdin)
+         (loop)]
 
-    (cond
+        ;; read-bytes-avail!-evt results in an integer. we have
-      ;; read-line-evt results in a string. we have something to write
+        ;; something to read from stdout.
-      ;; on stdin.
+        [(integer? evt-result)
-      [(string? evt-result)
+         (display (bytes->string/utf-8 (subbytes buffer 0 evt-result)))
-       (displayln evt-result stdin)
+         (flush-output)
-       (flush-output stdin)
+         (loop)]
-       (loop)]
 
-      ;; read-bytes-avail!-evt results in an integer. we have
+        ;; either event may EOF, which means that ed has died.
-      ;; something to read from stdout.
+        [(eof-object? evt-result)
-      [(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.
+         ;; clean up
-      [(eof-object? evt-result)
+         (close-output-port stdin)
-       ;; clean up
+         (close-input-port stdout)
-       (close-output-port stdin)
+         (close-input-port stderr)
-       (close-input-port stdout)
+         (proc 'kill)
-       (close-input-port stderr)
-       (proc 'kill)])))
 
-(loop)
+         path])))
-
+  (loop))
-(displayln "goodbye")
-(flush-output)
-
-(exit)