#! /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))))

;; 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
;; 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.

(match-define
  (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)))])

    (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)])))

(loop)

(displayln "goodbye")
(flush-output)

(exit)