w6vvn/palps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

turn the ed wrapper into its own procedure

Browse Source
This commit is contained in:
w6vvn
2025-09-09 15:21:25 -07:00
parent 896be50c0a
commit 520a0c888f
1 changed files with 33 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

95
palps.rkt
View File

@@ -8,75 +8,46 @@
(or/c char-numeric? char-alphabetic? (curry char=? #\-)) (or/c char-numeric? char-alphabetic? (curry char=? #\-))
(string->list call)))) (string->list call))))
;; 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")
(displayln "visit https://gitea.farpn.net/w6vvn/palps for an explanation")
(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 ;; unfortunately, we cannot just exec red and let it take over the
;; I/O. ed, being the standard text editor, only works with standard ;; 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 ;; 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 ;; ed, the standard text editor. so we need to wrap the input and
;; output ports ourselves in order to provide this translation. ;; output ports ourselves in order to provide this translation.
(define (ed)
(match-define
(list stdout stdin pid stderr proc)
(process* "/usr/bin/red"
"-p*"
#: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) ;; clean up
(display (bytes->string/utf-8 (subbytes buffer 0 evt-result))) (close-output-port stdin)
(flush-output) (close-input-port stdout)
(loop)] (close-input-port stderr)
(proc 'kill)])))
;; either event may EOF, which means that ed has died. (loop))
[(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)