From 939abc77dc9c2854e192d8caa1fac0bc80a2736b Mon Sep 17 00:00:00 2001 From: w6vvn Date: Tue, 9 Sep 2025 17:05:01 -0700 Subject: [PATCH] implement a session interface --- palps.rkt | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) diff --git a/palps.rkt b/palps.rkt index b061eb7..b31e33b 100755 --- a/palps.rkt +++ b/palps.rkt @@ -6,6 +6,9 @@ (build-path (find-system-path 'home-dir) (build-path ".local" "share" "palps"))) +;; directory of the current user of the program +(define call-dir (make-parameter (string->path "/nobody"))) + (define (call-valid? call) (and (<= (string-length call) 9) @@ -71,3 +74,58 @@ path]))) (loop)) + +;; "main" procedure to be executed in an interactive context i.e. for +;; BPQ +(define (session-startup) + (define call (string-downcase (read-line (current-input-port) 'any))) + + ;; something is seriously aswiss. + (when (not (call-valid? call)) + (raise-user-error 'palps-session "invalid callsign")) + + ;; drop SSID, if there is one. + (set! call (first (string-split call "-"))) + + (parameterize ([call-dir (build-path data-dir call)]) + ;; at the moment, "being authorized" just means that the sysadmin + ;; has granted a directory for that callsign. + (when (not (directory-exists? (call-dir))) + (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) + + (raise-user-error 'palps-session "unauthorized user")) + + (parameterize ([current-directory (call-dir)]) + (session)))) + +(define (session) + (display "palps > ") + (flush-output) + + (match (regexp-match #px"(\\w+)\\s*(.*)" + (read-line (current-input-port) 'any)) + [(list _ "ls" url) + (for-each (λ (p) (displayln (path->string p))) + (directory-list))] + + [(list _ "ed" name) + (let ([path (if (file-exists? name) + (ed (our-make-temporary-file name)) + (ed))]) + (copy-file path name #:exists-ok? #t))] + + [(or (list _ "bye" _) + (list _ "b" _) + (list _ "quit" _) + (list _ "q" _)) + (displayln "goodbye") + (exit)] + + [else + (displayln "no such command")]) + + (session)) + +(session-startup)