implement a session interface

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,61 @@
 
          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))
+     (flush-output)]
+
+    [(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")
+     (flush-output)
+     (exit)]
+
+    [else
+     (displayln "no such command")
+     (flush-output)])
+
+  (session))
+
+(session-startup)