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

@@ -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/"
+   (keywords
-				(in-home ".config/starvat/")))
+	(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

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

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)))
+	  (define request (get-request (session-record-port session)))
-	  (put-string (session-record-port session)
+	  (let-on ((response (<- handler 'handle request)))
-				  (string-append "41 Server is being written!" "\r\n"))
+			  (put-string (session-record-port session) response))
 	  (bye session close-request/rdwr)))
    ((close)
 	(close ($ listening-socket)))))