Files
palps/palps.rkt

74 lines
2.4 KiB
Racket
Executable File

#! /usr/bin/env /usr/local/bin/racket
#lang racket
;; default directory used for storing dynamic application data
(define data-dir
(build-path (find-system-path 'home-dir)
(build-path ".local" "share" "palps")))
(define (call-valid? call)
(and
(<= (string-length call) 9)
(andmap
(or/c char-numeric? char-alphabetic? (curry char=? #\-))
(string->list call))))
(define (our-make-temporary-file [copy-from #f])
;; when deployed as a systemd socket, this program is expected to be
;; ran with PrivateTmp. however, in case this is not true, we still
;; make our own directory. "red", the restricted version of "ed",
;; has no facility for getting outside of the directory we start it
;; in.
(make-temporary-file "red.~a"
#:copy-from copy-from
#:base-dir (make-temporary-directory)))
;; 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)))
(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)
path])))
(loop))