67 lines
2.2 KiB
Racket
Executable File
67 lines
2.2 KiB
Racket
Executable File
#! /usr/bin/env /usr/local/bin/racket
|
|
#lang racket
|
|
|
|
(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)
|
|
;; 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" #: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))
|