turn the ed wrapper into its own procedure
This commit is contained in:
33
palps.rkt
33
palps.rkt
@@ -8,35 +8,12 @@
|
|||||||
(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
|
(match-define
|
||||||
(list stdout stdin pid stderr proc)
|
(list stdout stdin pid stderr proc)
|
||||||
(process* "/usr/bin/red"
|
(process* "/usr/bin/red"
|
||||||
@@ -73,10 +50,4 @@
|
|||||||
(close-input-port stdout)
|
(close-input-port stdout)
|
||||||
(close-input-port stderr)
|
(close-input-port stderr)
|
||||||
(proc 'kill)])))
|
(proc 'kill)])))
|
||||||
|
(loop))
|
||||||
(loop)
|
|
||||||
|
|
||||||
(displayln "goodbye")
|
|
||||||
(flush-output)
|
|
||||||
|
|
||||||
(exit)
|
|
||||||
|
|||||||
Reference in New Issue
Block a user