From 61e8ea172f27c09fa3a094c61e2042e0089e2a5b Mon Sep 17 00:00:00 2001 From: Skylar Hill Date: Fri, 10 Nov 2023 23:02:20 -0600 Subject: [PATCH] Build basic process (non-working) It doesn't work for because the session gets invalidated for, and I quote, "some reason." Thanks, guile-gnutls. The code is also ugly and needs refactoring to be cleaner. We can separate a lot of things into their own functions for readability. --- scripts/starvat.in | 32 ++++++++++++++++++++--- starvat/handler.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++ starvat/listener.scm | 14 +++++----- 3 files changed, 97 insertions(+), 10 deletions(-) create mode 100644 starvat/handler.scm diff --git a/scripts/starvat.in b/scripts/starvat.in index 1f1adc2..6d5f07f 100644 --- a/scripts/starvat.in +++ b/scripts/starvat.in @@ -6,6 +6,8 @@ (config api) (config licenses) (config parser sexp) + (ice-9 sandbox) + (goblins) (starvat listener) (starvat handler)) @@ -19,13 +21,37 @@ (synopsis "A Gemini server based on Spritely's Goblins") (description "TODO") - (directory '("/etc/starvat/" - (in-home ".config/starvat/"))) + (keywords + (list + (setting + (name 'resources) + (default `(("localhost" . ,(string-append (getenv "HOME") + "/gemini")))) + (test list?) + (handler eval-in-sandbox)))) + (directory (list (path (given "/etc/starvat/") + (eager? #f)) + (in-home ".config/starvat"))) (parser simple-sexp-parser) (generate-cmdtree? #t))) (define (main args) - (define options (getopt-config-auto args %configuration))) + (define options (getopt-config-auto args %configuration)) + (define listener-vat (spawn-vat)) + (define handler-vat (spawn-vat)) + (define listener + (with-vat listener-vat + (spawn ^listener 1965 + (string-append (getenv "HOME") "/localhost.crt") + (string-append (getenv "HOME") "/localhost.key")))) + (display options) + (display (option-ref options 'resources)) + (define handler + (with-vat handler-vat + (spawn ^handler options))) + (with-vat listener-vat + ($ listener 'init) + ($ listener 'listen handler))) ;;; Local Variables: ;;; mode: scheme diff --git a/starvat/handler.scm b/starvat/handler.scm new file mode 100644 index 0000000..e6035b5 --- /dev/null +++ b/starvat/handler.scm @@ -0,0 +1,61 @@ +(define-module (starvat handler) + #:use-module (config) + #:use-module (goblins) + #:use-module (goblins actor-lib methods) + #:use-module (goblins actor-lib let-on) + #:use-module (goblins actor-lib cell) + #:use-module (web uri) + #:use-module (ice-9 textual-ports)) + +(define (response-code code) + (case code + ((input) "10") + ((sensitive-input) "11") + ((success) "20") + ((redirect-temporary) "30") + ((redirect-permanent) "31") + ((temporary-failure) "40") + ((server-unavailable) "41") + ((cgi-error) "42") + ((proxy-error) "43") + ((slow-down) "44") + ((permanent-failure) "50") + ((not-found) "51") + ((gone) "52") + ((proxy-request-refused) "53") + ((bad-request) "59") + ((client-certificate-required) "60") + ((certificate-not-authorised) "61") + ((certificate-not-valid) "62"))) + +(define (resource-dir hostname resources) + (define dir (assoc hostname resources)) + (if dir + (cdr dir) + #f)) + +(define* (build-response code meta #:optional body) + (if body + (string-append (response-code code) " " meta "\r\n" body) + (string-append (response-code code) " " meta "\r\n"))) + +(define-public (^handler bcom config) + (define conf (spawn ^cell config)) + (methods + ((handle raw-url) + (define url (string->uri raw-url)) + (if (not url) + (build-response 'bad-request "Could not parse URL") + (let ((dir (resource-dir (uri-host url) + (option-ref ($ conf) 'resources)))) + (display dir) + (if (not dir) + (build-response 'not-found "Unknown host") + (if (not (file-exists? (string-append dir + (uri-path url)))) + (build-response 'not-found "Unknown path") + (build-response 'success "text/gemini" + (call-with-input-file + (string-append dir + (uri-path url)) + get-string-all))))))))) diff --git a/starvat/listener.scm b/starvat/listener.scm index 5a7c513..10a999e 100644 --- a/starvat/listener.scm +++ b/starvat/listener.scm @@ -4,8 +4,8 @@ #:use-module (goblins actor-lib methods) #:use-module (goblins actor-lib let-on) #:use-module (goblins actor-lib cell) - #:use-module (web uri) - #:use-module (ice-9 textual-ports)) + #:use-module (ice-9 textual-ports) + #:export (^listener)) (define* (get-request port #:optional (acc "")) (define next-char (get-char port)) @@ -23,7 +23,6 @@ (define server (spawn ^cell (make-session connection-end/server))) (set-session-credentials! ($ server) ($ credentials)) (set-session-default-priority! ($ server)) - (methods ((set-port new-port) ($ current-port new-port)) @@ -38,7 +37,8 @@ (fcntl s F_SETFD FD_CLOEXEC) (listen s 5) s))) - ((listen) + ((listen handler) + (display handler) (let* ((session (make-session connection-end/server)) (sock (car (accept ($ listening-socket))))) (set-session-credentials! session ($ credentials)) @@ -47,9 +47,9 @@ (fileno sock)) (set-port-encoding! sock "UTF-8") (handshake session) - (write (get-request (session-record-port session))) - (put-string (session-record-port session) - (string-append "41 Server is being written!" "\r\n")) + (define request (get-request (session-record-port session))) + (let-on ((response (<- handler 'handle request))) + (put-string (session-record-port session) response)) (bye session close-request/rdwr))) ((close) (close ($ listening-socket)))))